#!/usr/bin/wish
# Copyright (c) 1997-1999 Miller Puckette.
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.

# changed by Thomas Musil 09.2001
# between "pdtk_graph_dialog -- dialog window for graphs"
# and "pdtk_array_dialog -- dialog window for arrays"
# a new dialogbox was inserted, named:
# "pdtk_iemgui_dialog -- dialog window for iem guis"
#
# all this changes are labeled with #######iemlib##########

# set pd_nt (bad name) 0 for unix, 1 for microsoft, and 2 for Mac OSX.
if { $tcl_platform(platform) == "windows" }  {
    set pd_nt 1
    set ctrl_key "Control"
    # fonts
    set defaultFontFamily {DejaVu Sans Mono}
    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
    # mouse cursors
    set cursor_runmode_nothing "arrow"
    set cursor_runmode_clickme "right_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"
	# set file types that open/save recognize
	set filetypes {
		{{Pd Files}         {.pd}  }
		{{Max Patch Files}  {.pat} }
		{{Max Text Files}   {.mxt} }
		{{Max Binary Files} {.mxb} }
		{{Max Help Files}   {.help} }
	}
	# use CommonProgramFiles by default instead because its a lot easier to
	# find. Microsoft seems to have carefully hidden the AppData folder from
	# all but the most determined users.
	#set externalsdir "$::env(AppData)/Pd"
	set externalsdir "$::env(CommonProgramFiles)/Pd"
} elseif { $tcl_platform(os) == "Darwin" } {  
    set pd_nt 2
	set ctrl_key "Mod1"
    # fonts
    set defaultFontFamily Monaco
    # mouse cursors
    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"
	# set file types that open/save recognize
	set filetypes {
		{{Pd Files}                {.pd}  }
		{{Max Patch Files (.pat)}  {.pat} }
		{{Max Text Files (.mxt)}   {.mxt} }
		{{Max Binary Files (.mxb)} {.mxb} }
		{{Max Help Files (.help)}  {.help} }
	}
	set externalsdir "$::env(HOME)/Library/Pd"
} else { 
    set pd_nt 0
    set ctrl_key "Control"
    # fonts
    set defaultFontFamily {DejaVu Sans Mono}
    # mouse cursors
    set cursor_runmode_nothing "left_ptr"
    set cursor_runmode_clickme "right_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"
	# set file types that open/save recognize
	set filetypes {
		{{pd files}         {.pd}  }
		{{max patch files}  {.pat} }
		{{max text files}   {.mxt} }
		{{max binary files} {.mxb} }
		{{max help files}   {.help} }
	}
	set externalsdir "$::env(HOME)/pd-externals"
}        

# make sure the user folder for installing externals exists
catch {
	if { ! [file exists $externalsdir] && [file exists [file dirname $externalsdir]] } {
		puts stderr "Creating folder for user-installed externals: \n\t$externalsdir"
		file mkdir $externalsdir
	}
}


# namespace for general-purpose functions
proc pdtk_encode { listdata } {
    set outlist {}
    foreach this_path $listdata {
        if {0==[string match "" $this_path]} {
            lappend outlist [pdtk_encodedialog $this_path]
        }
    }
    return $outlist
}


# args is a list of length 1 or 2,
# specifying optional additional x, y offsets for the window
proc center_window { w args } {
    set offx 0
    set offy 0

    if { [llength $args] >= 2 } {
        set offx [lindex $args 0]
        set offy [lindex $args 1]
    }

    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
        - [winfo vrootx [winfo parent $w]] + $offx]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
        - [winfo vrooty [winfo parent $w]] + $offy]
    wm geom $w +$x+$y
}


# start Pd-extended font hacks -----------------------------

# Pd-0.39.2-extended hacks to make font/box sizes the same across platform
puts stderr "tk scaling is [tk scaling]"
tk scaling 1

# for some reason, the fonts are bigger in Tcl/Tk 8.5 than 8.4
if {$pd_nt != 1 && $::tcl_version eq "8.5"} {
	set console_font_size 9
} else { 
	set console_font_size 12
}
# this font is for the Pd Window console text
font create console_font -family $defaultFontFamily -weight normal \
	-size $console_font_size
# this font is for text in Pd windows
font create text_font -family {Times} -size 14 -weight normal
# for text in Properties Panels and other panes
font create highlight_font -family $defaultFontFamily -size 14 -weight bold

# end Pd-extended font hacks -----------------------------

# begin hack to hide hidden files/folder in tk browser on unix ----------
if {$pd_nt == 0} {
    # load the dialog once, otherwise setting the vars will not work
    catch {tk_getOpenFile -with-invalid-argument} 

    # change the environment variables
    namespace eval ::tk::dialog::file {
    variable showHiddenBtn 1
    variable showHiddenVar 0
    }
}
# end hidden files/folder hack ------------------

# Tearoff is set to true by default:
set pd_tearoff 0
# turn off tearoff menus globally
#option add *tearOff 0

# jsarlo
set pd_array_listview_pagesize 1000
set pd_array_listview_id(0) 0
set pd_array_listview_entry(0) 0
set pd_array_listview_page(0) 0
# end jsarlo

# color scheme
set canvas_fill "white"
set text_color "#000"
set select_color "#00f"
set dash_outline "#f00"
set dash_fill "#f7f7f7"
set box_outline "#ccc"
set graph_outline "#777"
set atom_box_fill "#eee"
set msg_box_fill "#f8f8f6"
set obj_box_fill "#f6f8f8"
set signal_cord_highlight "#58a"
set signal_cord "#808095"
set signal_nlet $signal_cord
set msg_cord_highlight "#474"
set msg_cord "#565"
set msg_nlet "white"
set mixed_nlet "#88aaff"

if {$pd_nt == 1} {
    global pd_guidir
    set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]]
    regsub -all \\\\ $pd_gui2 / pd_gui3
    set pd_guidir [file normalize $pd_gui3/..]
    load $pd_guidir/bin/pdtcl.dll
}

if {$pd_nt == 2} {
    # turn on James Tittle II's fast drawing
    set tk::mac::useCGDrawing 1
    # anti-alias all lines that need it
    set tk::mac::CGAntialiasLimit 0
    global pd_guidir
    set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]]
    set pd_guidir [file normalize $pd_gui2/..]
    load $pd_guidir/bin/libPdTcl.dylib
    global pd_macready
    set pd_macready 0
    global pd_macdropped
    set pd_macdropped ""
    # tk::mac::OpenDocument is called with the filenames put into the 
    # var args whenever docs are either dropped on the Pd.app icon or 
    # opened from the Finder.
    # It uses menu_doc_open so it can handles numerous file types.
    proc tk::mac::OpenDocument {args} {
        global pd_macready pd_macdropped
        foreach file $args {
            if {$pd_macready != 0} {
                . configure -cursor watch
                .printout.text configure -cursor watch
                menu_doc_open [file dirname $file] [file tail $file]
            } else {
                set pd_macdropped $args
            }
        }
    }
	# intercept kAEQuitApplication from Cmd-Q
	proc ::tk::mac::Quit {} {
		puts stderr "::tk::mac::Quit"
		menu_quit
	}
}

# 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 .
    }
}

set pd_deffont {courier 12 bold}

set help_top_directory $pd_guidir/doc

#==============================================================================#
# pd-gui-rewrite-0.43 help browser backport

# 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]]]
# the pd-gui-rewrite-0.43 help browser is backported to Pd-extended 0.42
package require helpbrowser
package require msgcat

# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}

namespace eval ::pdwindow:: {
    proc verbose {level postme} {puts stderr "$level: $postme"}
    proc error {postme} {puts stderr $postme; pdtk_post $postme}
    proc warn {postme} {::pdwindow::error $postme}
}

set ::dialog_menubar .mbar
set ::modifier $ctrl_key
set ::sys_libdir $pd_guidir
switch $pd_nt {
    0 {set ::pd_path [list ~/pd-externals /usr/local/lib/pd-externals]}
    1 {set ::pd_path [list [file normalize $::env(AppData)/Pd] \
                          [file normalize $::env(CommonProgramFiles)/Pd]]}
    2 {set ::pd_path [list ~/Library/Pd /Library/Pd]}
}
#==============================================================================#

################## set up main window #########################
# the menus are instantiated here for the main window
# for the patch windows, they are created by pdtk_canvas_new
menu .mbar

menu .mbar.file -tearoff $pd_tearoff
.mbar add cascade -label File -menu .mbar.file
menu .mbar.edit -tearoff $pd_tearoff
.mbar add cascade -label Edit -menu .mbar.edit
menu .mbar.put -tearoff $pd_tearoff
.mbar add cascade -label Put -menu .mbar.put
menu .mbar.find -tearoff $pd_tearoff
.mbar add cascade -label Find -menu .mbar.find
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 "Media" -menu .mbar.audio
    menu .mbar.help -tearoff $pd_tearoff
    .mbar add cascade -label "Help" -menu .mbar.help
} else {
    menu .mbar.apple -tearoff 0
    .mbar add cascade -label "Apple" -menu .mbar.apple 
    # arrange menus according to Apple HIG
    .mbar add cascade -label "Media" -menu .mbar.audio
    .mbar add cascade -label "Window" -menu .mbar.windows
    menu .mbar.help -tearoff $pd_tearoff
    .mbar add cascade -label "Help" -menu .mbar.help
}

# fix menu font size on Windows with tk scaling = 1
if {$pd_nt == 1} {
    .mbar.file configure -font menuFont
    .mbar.edit configure -font menuFont
    .mbar.find configure -font menuFont
    .mbar.windows configure -font menuFont
    .mbar.audio configure -font menuFont
    .mbar.help configure -font menuFont
}

proc showhide_printouttext {state} {
    if {$state} {
        . configure -width 587 -height 458
        pack .printout -side bottom -fill both -expand 1
    } else {
        . configure -width 390 -height 90
        pack forget .printout
    }
}

set ctrls_audio_on 0
set ctrls_meter_on 0
set ctrls_inlevel 0
set ctrls_outlevel 0
set show_text_window 0

# tmp kludge to fix small fonts on windows, irrelevant in 0.43/gui-rewrite
if {$pd_nt == 1} {
    frame .controls -class PdWindow
} else {
    frame .controls
}
pack .controls -side top -fill x
frame .controls.switches
checkbutton .controls.switches.audiobutton -text {compute audio} \
    -variable ctrls_audio_on \
    -command {pd [concat pd dsp $ctrls_audio_on \;]}

checkbutton .controls.switches.meterbutton -text {peak meters} \
    -variable ctrls_meter_on \
    -command {pd [concat pd meters $ctrls_meter_on \;]}

checkbutton .controls.switches.console -text "console" \
    -variable show_console \
    -command {showhide_printouttext $show_console}
# the console is open by default
.controls.switches.console select  

pack .controls.switches.audiobutton .controls.switches.meterbutton \
    .controls.switches.console -side top -anchor w

frame .controls.inout
frame .controls.inout.in
label .controls.inout.in.label -text IN
entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3
button .controls.inout.in.clip -text {CLIP} -state disabled
pack .controls.inout.in.label .controls.inout.in.level \
    .controls.inout.in.clip -side top -pady 2

frame .controls.inout.out
label .controls.inout.out.label -text OUT
entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3
button .controls.inout.out.clip -text {CLIP} -state disabled
pack .controls.inout.out.label .controls.inout.out.level \
    .controls.inout.out.clip -side top -pady 2

button .controls.dio -text "DIO\nerrors" \
    -command {pd [concat pd audiostatus \;]}

pack .controls.inout.in .controls.inout.out -side left -padx 6
pack .controls.inout -side left -padx 14
pack .controls.switches -side right
pack .controls.dio -side right -padx 20


frame .printout
text .printout.text -relief raised -bd 2 -font console_font \
    -yscrollcommand ".printout.scroll set" -width 80
# .printout.text insert end "\n\n\n\n\n\n\n\n\n\n"
scrollbar .printout.scroll -command ".printout.text yview"
pack .printout.scroll -side right -fill y
pack .printout.text -side left -fill both -expand 1
pack .printout -side bottom -fill both -expand 1

proc pdtk_post {stuff} {
    .printout.text insert end $stuff
    .printout.text yview end-2char
}

proc pdtk_standardkeybindings {id} {
    global pd_nt ctrl_key
    bind $id <$ctrl_key-Key> {pdtk_canvas_ctrlkey %W %K 0}
    bind $id <$ctrl_key-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
}

proc pdtk_panelkeybindings {id panelname} {
    global pd_nt ctrl_key
    pdtk_standardkeybindings $id
    bind $id <KeyPress-Escape> [format "%s_cancel %s" $panelname $id]
    bind $id <KeyPress-Return> [format "%s_ok %s" $panelname $id]
    bind $id <$ctrl_key-Key-w> [format "%s_cancel %s" $panelname $id]
}

pdtk_standardkeybindings .
# hacks to add standard key bindings to the Pd window
bind . <$ctrl_key-Key-a> {.printout.text tag add sel 1.0 end}
bind . <$ctrl_key-Key-x> {tk_textCut .printout.text}
bind . <$ctrl_key-Key-c> {tk_textCopy .printout.text}
bind . <$ctrl_key-Key-v> {tk_textPaste .printout.text}
# beep if someone presses these keys in the Pd window
bind . <$ctrl_key-Key-w> {bell}
bind . <$ctrl_key-Key-e> {bell}
bind . <$ctrl_key-Key-s> {bell}
bind . <$ctrl_key-Shift-Key-S> {bell}
# kludge to add window control bindings to the Pd Window
if {$pd_nt == 2} {
	bind . <Mod1-quoteleft>  {menu_raisenextwindow}
} else {
	bind . <Control-Next>    {menu_raisenextwindow}
	#bind . <Control-Prior>   {menu_raisepreviouswindow} ;# needs Tcl/Tk 8.5
}


wm title . "Pd-extended"
# initial location of Pd window (+x+y)
wm geometry . +20+70
wm minsize . 390 90
. configure -menu .mbar -width 587 -height 458

# Intercept closing the main pd window: MP 20060413:
wm protocol . WM_DELETE_WINDOW menu_quit


############### set up global variables ################################

set untitled_number 1
if {$pd_nt == 2} {
    set untitled_directory $::env(HOME)
} else {
    set untitled_directory [pwd]
}
set pd_opendir $untitled_directory
set pd_savedir $untitled_directory
set pd_undoaction no
set pd_redoaction no
set pd_undocanvas no

################ utility functions #########################

# enquote a string to send it to a tcl function
proc pdtk_enquote {x} {
    set foo [string map {"," "" ";" "" \" ""} $x]
    set foo2 [string map {" " "\\ "} $foo]
    concat $foo2
}

#enquote a string to send it to Pd.  Blow off semi and comma; alias spaces
#we also blow off "{", "}", "\" because they'll just cause bad trouble later.
proc pdtk_unspace {x} {
    set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
    if {$y == ""} {set y "empty"}
    concat $y
}

#enquote a string for preferences (command strings etc.)
proc pdtk_encodedialog {x} {
    concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
}

proc pdtk_debug {x} {
    tk_messageBox -message $x -type ok
}

proc pdtk_watchdog {} {
    pd [concat pd watchdog \;]
    after 2000 {pdtk_watchdog}
}

proc pdtk_ping {} {
    pd [concat pd ping \;]
}

##### routine to ask user if OK and, if so, send a message on to Pd ######
proc pdtk_check {canvas x message default} {
    global pd_nt
	raise $canvas
    if {$pd_nt == 1} {
        set answer [tk_messageBox -message $x -type yesno -default $default \
            -icon question]
    } else {
        set answer [tk_messageBox -message $x -type yesno -default $default \
            -parent $canvas -icon question]
    }
    if {! [string compare $answer yes]}  {pd $message}
}

##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
proc pdtk_canvas_menuclose {window reply} {
	global pd_nt
	raise $window
	set filename [wm title $window]
	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 $window -icon question]
	switch -- $answer {
		yes { 
			pd [concat $window 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 ::untitled_directory
                        }
			pd $reply
		}
		no {pd $reply}
		cancel {}
	}
}

set menu_windowlist {} 

proc pdtk_fixwindowmenu {} {
    global menu_windowlist pd_nt
    .mbar.windows delete 0 end
	if {$pd_nt == 2} {
		.mbar.windows add command -label {Minimize} -command {menu_minimize .} \
			-accelerator [accel_munge "Ctrl+m"]
		.mbar.windows add command -label {Zoom} -command {menu_zoom .}
	} else {
		.mbar.windows add command -label "Next Window" -command {menu_raisenextwindow} \
			-accelerator "Ctrl+PageDown"
		#.mbar.windows add command -label "Previous Window" -command {menu_raisepreviouswindow} \
		#	-accelerator "Ctrl+PageUp"
	}
	.mbar.windows add separator
    .mbar.windows add command -label {parent window} -state disabled
    .mbar.windows add command -label {Pd window} -command menu_raise_console \
		-accelerator [accel_munge "Ctrl+r"] -state disabled
	.mbar.windows add separator
    foreach i $menu_windowlist {
        .mbar.windows add command -label [lindex $i 0] \
            -command [concat menu_domenuwindow [lindex $i 1]]
        menu_fixwindowmenu [lindex $i 1]
    }
}

####### Odd little function to make better Mac accelerators #####

proc accel_munge {acc} {
    global pd_nt

    if {$pd_nt == 2} {
        if [string is upper [string index $acc end]] {
            return [format "%s%s" "Shift+" \
                        [string toupper [string map {Ctrl Meta} $acc] end]]
        } else {
            return [string toupper [string map {Ctrl Meta} $acc] end]
        }
    } else {
        return $acc
    }
}



###############  the "New" menu command  ########################
proc menu_new {} {
    global untitled_number
    global untitled_directory
    if { ! [file isdirectory $untitled_directory]} {set untitled_directory $::env(HOME)}
    pd [concat pd filename Untitled-$untitled_number \
			[pdtk_enquote $untitled_directory] \;]
    pd {
        #N canvas;
        #X pop 1;
    }
    set untitled_number [expr $untitled_number + 1]
}

################## the "Open" menu command #########################

proc menu_open {} {
    global pd_opendir filetypes
    if { ! [file isdirectory $pd_opendir]} {set pd_opendir $::env(HOME)}
    set files [tk_getOpenFile -defaultextension .pd \
					  -multiple true \
                      -filetypes $filetypes -initialdir $pd_opendir]
    if {$files != ""} {
		foreach filename $files {
			open_file $filename
		}
	}
}

proc open_file {filename} {
    global pd_opendir pd_guidir pd_nt
	set directory [file dirname $filename]
	set basename [file tail $filename]
    if {[regexp -nocase -- "\.(pat|mxb|help)$" $basename]} {
		puts stderr "converting $filename"
		if {$pd_nt == 0} { 
			# on GNU/Linux, cyclist is installed into /usr/bin usually
			set cyclist "/usr/bin/cyclist" 
		} else {
			set cyclist "$pd_guidir/bin/cyclist"
		}
		puts stderr "$cyclist '$filename'"
		# convert Max binary to text .pat
		set binport [open "| \"$cyclist\" \"$filename\""]
		set convertedtext [read $binport]
		if { ! [catch {close $binport} err]} {
			if {! [file writable $directory]} {	set directory "/tmp" }
			set basename "$basename.pat"
			set textpatfile [open "$directory/$basename" w]
			puts $textpatfile $convertedtext
			close $textpatfile
			puts stderr "converted Max binary to text format: $directory/$basename"
		}
	}
    if {[regexp -nocase -- "\.(pd|pat|mxt)$" $basename]} {
        . configure -cursor watch
        .printout.text configure -cursor watch
        pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
        set pd_opendir $directory
    }
}

catch {
    package require tkdnd
    dnd bindtarget . text/uri-list <Drop> {
        foreach file %D {open_file $file}
    }
}

################## the "Message" menu command #########################
proc menu_send {} {
    global pd_nt ctrl_key
    destroy .sendpanel
    toplevel .sendpanel -class DialogWindow
    pdtk_standardkeybindings .sendpanel
    entry .sendpanel.entry -textvariable send_textvariable
    pack .sendpanel.entry -side bottom -fill both -ipadx 100
    .sendpanel.entry select from 0
    .sendpanel.entry select adjust end
    bind .sendpanel <$ctrl_key-Key-w> {destroy .sendpanel}
    bind .sendpanel <KeyPress-Escape> {destroy .sendpanel}
    bind .sendpanel.entry <KeyPress-Return> {
        pd [concat $send_textvariable \;]
    }
    focus .sendpanel.entry
}


################## menu commands for Mac OS X #########################

proc menu_minimize {window} {
	if {$window eq ""} { #Pd Window
		wm iconify [winfo toplevel .printout]
	} else {
		wm iconify [winfo toplevel $window]
	}
}

proc menu_zoom {window} {
	wm state $window zoomed
}

proc menu_raisenextwindow {} {
	raise [lindex [wm stackorder .] 0]
}

# lreverse came along in Tcl 8.5
#proc menu_raisepreviouswindow {} {
#	raise [lindex [lreverse [wm stackorder .]] 0]
#}

################## menu commands for console #########################

proc menu_raise_console {} {
	set pd_window .
	set top_window [lindex [wm stackorder $pd_window] end]
	if {$pd_window eq $top_window} {
		lower $pd_window
	} else {
		wm deiconify $pd_window
		raise $pd_window
	}
}

proc menu_toggle_console {} {.controls.switches.console invoke}

proc menu_clear_console {} {.printout.text delete 0.0 end}

################## the "Quit" menu command #########################
proc menu_really_quit {} {pd {pd quit;}}

proc menu_quit {} {pd {pd verifyquit;}}

######### the "audio" menu command  ###############
proc menu_audio {flag} {pd [concat pd dsp $flag \;]}

######### the "reselect" menu command ################
proc menu_reselect {name} {pd [concat $name reselect \;]}

######### the "documentation" menu command  ###############

set doc_number 1

# open text docs in a Pd window
proc menu_opentext {filename} {
    global doc_number
    global pd_guidir
    global pd_myversion
	global ctrl_key
    set name [format ".help%d" $doc_number]
    toplevel $name
    text $name.text -relief raised -bd 2 -font text_font \
        -yscrollcommand "$name.scroll set" -background white
    scrollbar $name.scroll -command "$name.text yview"
    pack $name.scroll -side right -fill y
    pack $name.text -side left -fill both -expand 1
    bind $name <$ctrl_key-Key-w> [concat destroy $name]
    
    set f [open $filename]
    while {![eof $f]} {
        set bigstring [read $f 1000]
        regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2
        regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3
        $name.text insert end $bigstring3
    }
    close $f
    set doc_number [expr $doc_number + 1] 
}

# open HTML docs from the menu using the OS-default HTML viewer
proc menu_openhtml {filename} {
    global pd_nt         

    if {$pd_nt == 0} {
        foreach candidate \
            { gnome-open xdg-open sensible-browser iceweasel firefox mozilla \
                  galeon konqueror netscape lynx } {
                      set browser [lindex [auto_execok $candidate] 0]
                      if {[string length $browser]} {
                          exec -- sh -c [format "%s '%s'" $browser $filename] &
                          break
                      }
                  }
    } elseif {$pd_nt == 2} {
        exec sh -c [format "open '%s'" $filename]
    } else {
        exec rundll32 url.dll,FileProtocolHandler \
            [format "%s" $filename] &
    }
}

proc menu_openpdpedia {} {
	set top_window [lindex [wm stackorder .] end]
	set window_title [wm title $top_window]
	set helpfile [regsub -- {(.*)-help.*} $window_title {\1}]
	if {$helpfile eq $window_title} {
		menu_openhtml "http://wiki.puredata.info/"
	} else {
		menu_openhtml "http://wiki.puredata.info/en/$helpfile"
	}
}

proc menu_doc_open {dir basename} {
    global pd_guidir
    
    if {[file pathtype $dir] eq "relative"} {
        set dirname "$pd_guidir/$dir"
    } else {
        set dirname $dir
    }

    if {[file isdirectory [file join $dirname $basename]]} {
        menu_openhtml $dirname/$basename
    } elseif {[regexp -nocase -- ".*\.(txt|c)$" $basename]} {
        menu_opentext $dirname/$basename
    } elseif {[regexp -nocase -- ".*\.(htm|html|pdf)$" $basename]} {
        menu_openhtml $dirname/$basename
    } else {
        set fullpath [file normalize [file join $dirname $basename]]
        set dirname [file dirname $fullpath]
        set basename [file tail $fullpath]
        pd [concat pd open [pdtk_enquote $basename] \
                [pdtk_enquote $dirname] \;]
    }
}

############# routine to add media, help, and apple menu items ###############

proc menu_addstd {mbar} {
    global pd_apilist pd_midiapilist pd_nt pd_tearoff
    #          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} 
    $mbar.audio add separator
    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 \;]}
    }
    for {set x 0} {$x<[llength $pd_midiapilist]} {incr x} {
        $mbar.audio add radiobutton -label [lindex [lindex $pd_midiapilist $x] 0] \
            -command {menu_midi 0} -variable pd_whichmidiapi \
            -value [lindex [lindex $pd_midiapilist $x] 1]\
            -command {pd [concat pd midi-setapi $pd_whichmidiapi \;]}
    }
    if {$pd_nt != 2} {
        $mbar.audio add separator
        $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 separator
    $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 MacOS X app menu

    # The menu on the main menubar named $whatever.apple while be treated
    # as a special menu on MacOS X.  Tcl/Tk assigns the $whatever.apple menu
    # to the app-specific menu in MacOS X that is named after the app,
    # so in our case, the Pd menu.  <hans@at.or.at>
    # See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
    if {$pd_nt == 2} {
        $mbar.apple add command -label "About Pd..." -command \
            {menu_doc_open doc/5.reference about.pd} 
        menu $mbar.apple.preferences -tearoff 0
        $mbar.apple add cascade -label "Preferences" -menu $mbar.apple.preferences
        $mbar.apple.preferences add command -label "Path..." \
            -command {pd pd start-path-dialog \;}
        $mbar.apple.preferences add command -label "Startup..." \
            -command {pd pd start-startup-dialog \;}
        $mbar.apple.preferences add command -label "Audio Settings..." \
            -command {pd pd audio-properties \;}
        $mbar.apple.preferences add command -label "MIDI settings..." \
            -command {pd pd midi-properties \;}
    }


    # the "Help" menu
    if {$pd_nt != 2} {
        $mbar.help add command -label {About Pd} \
            -command {menu_doc_open doc/5.reference about.pd}
    }
    $mbar.help add command -label {Html ...} \
        -command {menu_doc_open doc/1.manual index.htm} 
    $mbar.help add command -label {Browser ...} \
        -accelerator [accel_munge "Ctrl+b"] \
        -command {::helpbrowser::open_helpbrowser}
    $mbar.help add separator
    $mbar.help add command -label {puredata.info} \
        -command {menu_openhtml http://puredata.info} 
    $mbar.help add command -label {Pdpedia} \
        -command {menu_openpdpedia} 
    $mbar.help add command -label {FAQ} \
        -command {menu_openhtml http://puredata.info/docs/faq} 
    $mbar.help add separator
    $mbar.help add command -label {mailing lists} \
        -command {menu_openhtml http://puredata.info/community/lists} 
    $mbar.help add command -label {forums} \
        -command {menu_openhtml http://puredata.hurleur.com/} 
    $mbar.help add command -label {IRC chat} \
        -command {menu_openhtml irc://irc.freenode.net/dataflow} 
    $mbar.help add separator
	$mbar.help add command -label {report bug} -command \
		{menu_openhtml {http://sourceforge.net/tracker/?func=add&group_id=55736&atid=478070}} 
}

#################### the "File" menu for the Pd window ##############

.mbar.file add command -label New -command {menu_new} \
    -accelerator [accel_munge "Ctrl+n"]
.mbar.file add command -label Open -command {menu_open} \
    -accelerator [accel_munge "Ctrl+o"]
.mbar.file add  separator
.mbar.file add command -label Close -accelerator [accel_munge "Ctrl+w"] \
	-state disabled
.mbar.file add command -label Save -accelerator [accel_munge "Ctrl+s"] \
	-state disabled
.mbar.file add command -label "Save as..." -accelerator [accel_munge "Ctrl+S"] \
	-state disabled
.mbar.file add  separator
if {$pd_nt != 2} {
	.mbar.file add command -label "Message..." -command {menu_send} \
		-accelerator [accel_munge "Ctrl+m"]
	# On MacOS X, follow the standard Human Interface Guidelines
	# i.e. the Preferences menu under "Pd"
	.mbar.file add  separator
    .mbar.file add command -label Path... \
        -command {pd pd start-path-dialog \;}
    .mbar.file add command -label Startup... \
        -command {pd pd start-startup-dialog \;}
} else { # Mac OS X
	# Cmd-m is minimize window on Mac OS X, so remove binding
	.mbar.file add command -label "Message..." -command {menu_send}
	.mbar.file add  separator
	.mbar.file add command -label "Make app from patch..." -state disabled
	.mbar.file add command -label "Make app from folder..." -state disabled
}
.mbar.file add  separator
.mbar.file add command -label "Print..." -accelerator [accel_munge "Ctrl+p"] \
	-state disabled
if {$pd_nt != 2} {
# Mac OS X doesn't put Quit on the File menu
.mbar.file add  separator
.mbar.file add command -label Quit -command {menu_quit} \
    -accelerator [accel_munge "Ctrl+q"]
}

#################### the "Edit" menu for the Pd window ##############
# this is mostly a placeholder
.mbar.edit add command -label Undo -accelerator [accel_munge "Ctrl+z"] \
    -state disabled
.mbar.edit add command -label Redo -accelerator [accel_munge "Ctrl+Z"] \
    -state disabled
.mbar.edit add separator
# this should apply to .printout.text
.mbar.edit add command -label Cut  -accelerator [accel_munge "Ctrl+x"] \
    -command {tk_textCut .printout.text}
# this should apply to .printout.text
.mbar.edit add command -label Copy -accelerator [accel_munge "Ctrl+c"] \
    -command {tk_textCopy .printout.text}
.mbar.edit add command -label Paste -accelerator [accel_munge "Ctrl+v"] \
    -command {tk_textPaste .printout.text}
.mbar.edit add command -label Duplicate -accelerator [accel_munge "Ctrl+d"] \
    -state disabled
# this should apply to .printout.text
.mbar.edit add command -label {Select all} -accelerator [accel_munge "Ctrl+a"]\
    -command {.printout.text tag add sel 1.0 end}
.mbar.edit add command -label {Reselect} \
        -accelerator "Ctrl+Enter" -state disabled
.mbar.edit add separator
if {$pd_nt == 2} { # no key command for Mac OS X
	.mbar.edit add command -label {Text Editor} -state disabled
} else {
	.mbar.edit add command -label {Text Editor} -accelerator "Ctrl+t" \
	-state disabled
}
.mbar.edit add command -label Font -state disabled
.mbar.edit add command -label {Tidy Up} -state disabled
.mbar.edit add command -label "Toggle console" \
	-accelerator [accel_munge "Shift+Ctrl+r"] -command menu_toggle_console
.mbar.edit add command -label "Clear console" \
    -accelerator [accel_munge "Shift+Ctrl+l"] -command menu_clear_console
.mbar.edit add separator
# this should apply to .printout.text
.mbar.edit add command -label {Find...} -accelerator [accel_munge "Ctrl+f"] \
    -state disabled
# this should apply to .printout.text
.mbar.edit add command -label {Find Again} -accelerator [accel_munge "Ctrl+g"] \
    -state disabled
.mbar.edit add command -label {Find last error}
.mbar.edit add separator
.mbar.edit add command -label {Edit mode} -accelerator [accel_munge "Ctrl+e"] \
    -state disabled

#################### the "Find" menu for the Pd window ##############

.mbar.find add command -label Find -accelerator [accel_munge "Ctrl+f"] \
    -state disabled
.mbar.find add command -label {Find Again} -accelerator [accel_munge "Ctrl+g"] \
    -state disabled
.mbar.find add command -label {Find last error} -command {menu_finderror} 


#######  functions for embedding a patch into a standalone Mac OS X app #######

proc makeapp_promptreplace {appdir} {
	if {[file exists $appdir]} {
		set answer [tk_messageBox -message [concat overwrite $appdir "?"] \
						-type yesno -icon question]
		return [string equal $answer "yes"]
	} else {
		return 1
	}
}

proc makeapp_createapp {appdir} {
	global pd_guidir
	set pdapp_contents [file normalize "$pd_guidir/.."]
	pdtk_post "Copying:$pdapp_contents\n  -->\t$appdir/\n"
	catch {
		exec -- chmod -R u+w $appdir
		file delete -force -- $appdir
	}
	file mkdir $appdir
	file copy -- $pdapp_contents "$appdir/"
	file rename -force -- $appdir/Contents/org.puredata.pdextended.default.plist \
		$appdir/Contents/org.puredata.pdextended.plist
}

proc makeapp_makeinfoplist {appdir} {
	regexp {.*/(.+)\.app} $appdir -> appname
	pdtk_post "Setting up $appdir/Contents/Info.plist\n"
	set info_plist [open "$appdir/Contents/Info.plist" r]
	set info_plist_contents [read $info_plist]
	regsub -- {CFBundleName</key>.*?<string>Pd-.*extended.*<} $info_plist_contents \
		"CFBundleName</key>\n\t<string>$appname<" info_plist_contents
	set cfbundleversion [clock format [clock seconds] -format %Y.%m.%d]
	regsub -- {CFBundleVersion</key>.*?<string>.*?<} $info_plist_contents \
		"CFBundleVersion</key>\n\t<string>$cfbundleversion<" info_plist_contents
	regsub -- {org.puredata.pd.wish} $info_plist_contents \
		"org.puredata.pd.app.$appname" info_plist_contents
	regsub -- {<key>CFBundleDocumentTypes.+?</array>.+?</array>} \
		$info_plist_contents {} info_plist_contents
	regsub -- {<key>UTExportedTypeDeclarations.+</array>} $info_plist_contents \
		{} info_plist_contents
	close $info_plist
	set info_plist [open "$appdir/Contents/Info.plist" w]
	puts $info_plist $info_plist_contents
	close $info_plist		
}

proc makeapp_copycurrentpatch {appdir patch patchname isdir} {
	set extradir "$appdir/Contents/Resources/extra"
	file attributes $extradir -permissions u+w
	file mkdir "$extradir/app-auto-load"
	if {$isdir} {
		pdtk_post [format "Copying:%s\n  -->\t$extradir/\n" \
					   [file dirname $patch]]
		set patchdir [file normalize [file dirname $patch]]
		foreach file [glob -directory "$patchdir" -- * .*] {
			if {"$file"!="$appdir" && "$file"!="$patchdir/." && "$file"!="$patchdir/.."} {
				file copy -- $file "$extradir/app-auto-load/"
			}
		}
	} else {
		set embedded_patch "$extradir/app-auto-load/$patchname.pd"
		pdtk_post "Copying:$patch\n  -->\t$embedded_patch\n"
		file copy -- $patch $embedded_patch
	}
}

proc makeapp_getpatchname {top_window} {
	set top_window_path [wm attributes $top_window -titlepath]
	if {$top_window_path != ""} {
		return $top_window_path
	} else {
		return ""
	}
}

proc makeapp_embedprefs {appdir patch_to_open} {
	pdtk_post "Setting up $appdir/Contents/org.puredata.pdextended.plist\n"
	set plist [open "$appdir/Contents/org.puredata.pdextended.plist" r]
	set new_plist [read $plist]
	close $plist
	regsub -- {flags</key>.*?<string>.*?<} $new_plist \
		"flags</key>\n\t<string>-open hcs/embed.pd -open $patch_to_open<" new_plist
	set plist [open "$appdir/Contents/org.puredata.pdextended.plist" w]
	puts $plist $new_plist
	close $plist		
}

proc makeapp_busypanel {appdir} {
	toplevel .makeapp
	wm title .makeapp "Making App"
	wm attributes .makeapp -topmost 1
	wm resizable .makeapp 0 0
	label .makeapp.label -text "Making App... in $appdir..."
	pack .makeapp.label -side top -fill both -ipadx 200 -ipady 100
}

###########  functions for menu functions on document windows ########

proc menu_makeapp {isdir} {
	set top_window [lindex [wm stackorder .] end]
	menu_windowparent $top_window
	set patch [makeapp_getpatchname $top_window]
	if {$patch == ""} {
		pdtk_post \
			"No patch found! Select an open parent patch with the mouse, then try again.\n"
		return
	}
	# TODO set -parent to patch being turned into app
	pdtk_post "Select name for app to build...\n"
	set appdir [tk_getSaveFile -filetypes { {{Mac OS X Application} {.app}} } \
				   -parent $top_window -defaultextension .app \
				   -title "Save application to..."]
	if {$appdir != ""} {
		if {![string match "*.app" $appdir]} {
			set appdir "$appdir.app"
#			pdtk_post "Adding .app extension: $appdir\n"
		}
		if {[makeapp_promptreplace $appdir]} {
			makeapp_busypanel $appdir
			makeapp_createapp $appdir
			.makeapp.label configure -text "Configuring Info.plist..."
			makeapp_makeinfoplist $appdir
			.makeapp.label configure -text "Setting patch name..."
			regexp {.*/(.*?)\.pd} $patch -> patchname
			.makeapp.label configure -text "Copying current patch..."
			makeapp_copycurrentpatch $appdir $patch $patchname $isdir
			.makeapp.label configure -text "Setting embedded preferences..."
			makeapp_embedprefs $appdir "app-auto-load/$patchname.pd"
			pdtk_post "$appdir is complete!\n"
			destroy .makeapp
		}
	}
}

proc menu_save {name} {
    if {$name eq ""} {bell;return}
    if {[winfo toplevel $name] eq "."} {bell;return}
    pdtk_canvas_checkgeometry $name
    pd [concat $name menusave \;]
}

proc menu_saveas {name} {
    if {$name eq ""} {bell;return}
    if {[winfo toplevel $name] eq "."} {bell;return}
    pdtk_canvas_checkgeometry $name
    pd [concat $name menusaveas \;]
}

proc menu_print {name} {
    if {$name eq ""} {bell;return}
    if {[winfo toplevel $name] eq "."} {bell;return}
    set filename [tk_getSaveFile -initialfile pd.ps \
                      -defaultextension .ps \
                      -filetypes { {{postscript} {.ps}} }]

    if {$filename != ""} {
        $name.c postscript -file $filename 
    }
}

proc menu_close {name} {
    pdtk_canvas_checkgeometry $name
    pd [concat $name menuclose 0 \;]
}

proc menu_really_close {name} {
    pdtk_canvas_checkgeometry $name
    pd [concat $name menuclose 1 \;]
}

proc menu_undo {name} {
    global pd_undoaction
    global pd_redoaction
    global pd_undocanvas
    if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
        pd [concat $name undo \;]
    }
}

proc menu_redo {name} {
    global pd_undoaction
    global pd_redoaction
    global pd_undocanvas
    if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
        pd [concat $name redo \;]
    }
}

proc menu_cut {name} {
    pd [concat $name cut \;]
}

proc menu_copy {name} {
    pd [concat $name copy \;]
}

proc menu_paste {name} {
    pd [concat $name paste \;]
}

proc menu_duplicate {name} {
    pd [concat $name duplicate \;]
}

proc menu_selectall {name} {
    pd [concat $name selectall \;]
}

proc menu_texteditor {name} {
    pd [concat $name texteditor \;]
}

proc menu_font {name} {
    pd [concat $name menufont \;]
}

proc menu_tidyup {name} {
    pd [concat $name tidy \;]
}

proc menu_editmode {name} {
    pd [concat $name editmode 0 \;]
}

proc menu_object {name accel} {
    pd [concat $name obj $accel \;]
}

proc menu_message {name accel} {
    pd [concat $name msg $accel \;]
}

proc menu_floatatom {name accel} {
    pd [concat $name floatatom $accel \;]
}

proc menu_symbolatom {name accel} {
    pd [concat $name symbolatom $accel \;]
}

proc menu_comment {name accel} {
    pd [concat $name text $accel \;]
}

proc menu_graph {name} {
    pd [concat $name graph \;]
}

proc menu_array {name} {
    pd [concat $name menuarray \;]
}

############iemlib##################
proc menu_bng {name accel} {
    pd [concat $name bng $accel \;]
}

proc menu_toggle {name accel} {
    pd [concat $name toggle $accel \;]
}

proc menu_numbox {name accel} {
    pd [concat $name numbox $accel \;]
}

proc menu_vslider {name accel} {
    pd [concat $name vslider $accel \;]
}

proc menu_hslider {name accel} {
    pd [concat $name hslider $accel \;]
}

proc menu_hradio {name accel} {
    pd [concat $name hradio $accel \;]
}

proc menu_vradio {name accel} {
    pd [concat $name vradio $accel \;]
}

proc menu_vumeter {name accel} {
    pd [concat $name vumeter $accel \;]
}

proc menu_mycnv {name accel} {
    pd [concat $name mycnv $accel \;]
}

############iemlib##################

# correct edit menu, enabling or disabling undo/redo
# LATER also cut/copy/paste
proc menu_fixeditmenu {name} {
    global pd_undoaction
    global pd_redoaction
    global pd_undocanvas
    #    puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction]
    if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
        $name.m.edit entryconfigure "Undo*" -state normal \
            -label [concat "Undo " $pd_undoaction]
    } else {
        $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo"
    }
    if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
        $name.m.edit entryconfigure "Redo*" -state normal\
            -label [concat "Redo " $pd_redoaction]
    } else {
        $name.m.edit entryconfigure "Redo*" -state disabled
    }
}

# message from Pd to update the currently available undo/redo action
proc pdtk_undomenu {name undoaction redoaction} {
    global pd_undoaction
    global pd_redoaction
    global pd_undocanvas
    #    puts stderr [concat pdtk_undomenu $name $undoaction $redoaction]
    set pd_undocanvas $name
    set pd_undoaction $undoaction
    set pd_redoaction $redoaction
    if {$name != "nobody"} {
        #    unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25
        menu_fixeditmenu $name
    }
}

proc menu_windowparent {name} {
    pd [concat $name findparent \;]
}

proc menu_findagain {name} {
    pd [concat $name findagain \;]
}

proc menu_finderror {} {
    pd [concat pd finderror \;]
}

proc menu_domenuwindow {i} {
    raise $i
}

proc menu_fixwindowmenu {name} {
    global menu_windowlist pd_tearoff pd_nt
    $name.m.windows add command
	if {$pd_nt == 2} {
		$name.m.windows delete 6 end
	} else {
		if $pd_tearoff {
			$name.m.windows delete 4 end
		} else {
			$name.m.windows delete 3 end
		}
	}
    foreach i $menu_windowlist {
        $name.m.windows add command -label [lindex $i 0] \
            -command [concat menu_domenuwindow [lindex $i 1]]
    }
}

################## the "find" menu item ###################

set find_canvas nobody
set find_string ""
set find_count 1
set find_wholeword 1

proc find_ok {name} {
    global find_string find_canvas find_wholeword
    pd [concat $find_canvas find [pdtk_encodedialog $find_string] \
        $find_wholeword \;]
    after 50 destroy $name
}

proc find_cancel {name} {
    after 50 destroy $name
}

proc menu_findobject {canvas} {
    global find_string find_canvas find_count find_wholeword
    
    set name [format ".find%d" $find_count]
    set find_count [expr $find_count + 1]

    set find_canvas $canvas
    
    toplevel $name -class DialogWindow
	wm geometry $name =400x125+150+100
	wm resizable $name 0 0
	catch {wm attributes $name -topmost 1}

    pdtk_panelkeybindings $name "find"

	entry $name.entry -width 54 -font 18 -textvariable find_string \
		-highlightthickness 2 -highlightcolor blue -relief sunken
    focus $name.entry
    pack $name.entry -side top -padx 10 -pady 10
    checkbutton $name.wholeword -variable find_wholeword \
        -text {whole word} -anchor e
    pack $name.wholeword -side left -padx 30

    button $name.close -text "Close" -command "find_cancel $name" -width 9
    button $name.button -text "Find" -command "find_ok $name" -width 9 -default active
	pack $name.button $name.close -side right -padx 10 -pady 15
}


############# pdtk_canvas_new -- create a new canvas ###############
proc pdtk_canvas_new {name width height geometry editable} {
    global pd_tearoff
    global pd_nt
    global tcl_version
	global canvas_fill

    toplevel $name -menu $name.m
    wm group $name .
    # slide offscreen windows into view
    if {$tcl_version >= 8.4} {
        set geometry [split $geometry +]
        set i 1
        foreach geo {width height} {
            set screen($geo) [winfo screen$geo .]
            if {[expr [lindex $geometry $i] + [set $geo]] > $screen($geo)} {
                set pos($geo) [expr $screen($geo) - [set $geo]]
                if {$pos($geo) < 0} {set pos($geo) 0}
                lset geometry $i $pos($geo)
            }
            incr i
        }
        if { $pd_nt == 2 && [lindex $geometry 2] < 22 } {
            lset geometry 2 22
        }
        set geometry [join $geometry +] 
    }
    wm geometry $name $geometry
    canvas $name.c -width $width -height $height -background $canvas_fill \
		-highlightthickness 0 \
        -yscrollcommand "$name.scrollvert set" \
        -xscrollcommand "$name.scrollhort set" \
        -scrollregion [concat 0 0 $width $height] 

    scrollbar $name.scrollvert -command "$name.c yview"
    scrollbar $name.scrollhort -command "$name.c xview" \
        -orient horizontal

#    pack $name.scrollhort -side bottom -fill x
#    pack $name.scrollvert -side right -fill y
    pack $name.c -side left -expand 1 -fill both
    wm minsize $name 50 20
    wm geometry $name $geometry
    # the file menu
	
    # The menus are instantiated here for the patch windows.
    # For the main window, they are created on load, at the 
    # top of this file.
    menu $name.m
    menu $name.m.file -tearoff $pd_tearoff
    $name.m add cascade -label File -menu $name.m.file

    $name.m.file add command -label New -command {menu_new} \
        -accelerator [accel_munge "Ctrl+n"]

    $name.m.file add command -label Open -command {menu_open} \
        -accelerator [accel_munge "Ctrl+o"]

    $name.m.file add  separator
    $name.m.file add command -label Close \
        -command [concat menu_close $name] \
        -accelerator [accel_munge "Ctrl+w"]

    $name.m.file add command -label Save -command [concat menu_save $name] \
        -accelerator [accel_munge "Ctrl+s"]

    $name.m.file add command -label "Save as..." \
        -command [concat menu_saveas $name] \
        -accelerator [accel_munge "Ctrl+S"]
    $name.m.file add  separator

    # arrange menus according to Apple HIG
    if {$pd_nt != 2 } {
		$name.m.file add command -label "Message..." -command {menu_send} \
			-accelerator [accel_munge "Ctrl+m"]
		# these are now part of Preferences... on Mac OS X
        $name.m.file add command -label Path... \
            -command {pd pd start-path-dialog \;} 
        $name.m.file add command -label Startup... \
            -command {pd pd start-startup-dialog \;} 
    } else { 
		# Cmd-m is minimize window on Mac OS X		
		$name.m.file add command -label "Message..." -command {menu_send}
		$name.m.file add  separator
		$name.m.file add command -label "Make app from patch..." \
			-command {menu_makeapp 0}
		$name.m.file add command -label "Make app from folder..." \
			-command {menu_makeapp 1}
	}
    $name.m.file add separator
    $name.m.file add command -label "Print..." -command [concat menu_print $name] \
        -accelerator [accel_munge "Ctrl+p"]
	if {$pd_nt != 2} {
		# Mac OS X doesn't put Quit on the File menu
		$name.m.file add separator
		$name.m.file add command -label Quit -command {menu_quit} \
			-accelerator [accel_munge "Ctrl+q"]
	}

    # the edit menu
    menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff
    $name.m add cascade -label Edit -menu $name.m.edit
    
    $name.m.edit add command -label Undo -command [concat menu_undo $name] \
        -accelerator [accel_munge "Ctrl+z"]

    $name.m.edit add command -label Redo -command [concat menu_redo $name] \
        -accelerator [accel_munge "Ctrl+Z"]

    $name.m.edit add separator

    $name.m.edit add command -label Cut -command [concat menu_cut $name] \
        -accelerator [accel_munge "Ctrl+x"]

    $name.m.edit add command -label Copy -command [concat menu_copy $name] \
        -accelerator [accel_munge "Ctrl+c"]

    $name.m.edit add command -label Paste \
        -command [concat menu_paste $name] \
        -accelerator [accel_munge "Ctrl+v"]

    $name.m.edit add command -label Duplicate \
        -command [concat menu_duplicate $name] \
        -accelerator [accel_munge "Ctrl+d"]

    $name.m.edit add command -label {Select all} \
        -command [concat menu_selectall $name] \
        -accelerator [accel_munge "Ctrl+a"]

    $name.m.edit add command -label {Reselect} \
        -command [concat menu_reselect $name] \
        -accelerator "Ctrl+Enter"

    $name.m.edit add separator
	if {$pd_nt == 2} { # no key command on Mac OS X, conflicts with standard
		$name.m.edit add command -label {Text Editor} \
			-command [concat menu_texteditor $name]
	} else {
		$name.m.edit add command -label {Text Editor} \
			-accelerator [accel_munge "Ctrl+t"] \
			-command [concat menu_texteditor $name]
	}

    $name.m.edit add command -label Font \
        -command [concat menu_font $name] 

    $name.m.edit add command -label {Tidy Up} \
        -command [concat menu_tidyup $name]

    $name.m.edit add command -label "Toggle console" \
        -accelerator [accel_munge "Shift+Ctrl+r"] \
        -command [concat .controls.switches.console invoke]

    $name.m.edit add command -label "Clear console" \
        -accelerator [accel_munge "Shift+Ctrl+l"] \
        -command [concat menu_clear_console]

    $name.m.edit add separator
    
    # Apple, Microsoft, and others put find functions in the Edit menu.
    $name.m.edit add command -label {Find...} \
        -accelerator [accel_munge "Ctrl+f"] \
        -command [concat menu_findobject $name] 
    $name.m.edit add command -label {Find Again} \
        -accelerator [accel_munge "Ctrl+g"] \
        -command [concat menu_findagain $name] 
    $name.m.edit add command -label {Find last error} \
        -command [concat menu_finderror] 

    $name.m.edit add separator

    ############iemlib##################
    # instead of "red = #BC3C60" we take "grey85", so there is no difference,
    # if widget is selected or not.

    $name.m.edit add checkbutton -label "Edit mode" \
        -indicatoron true -selectcolor grey85 \
        -command [concat menu_editmode $name] \
        -accelerator [accel_munge "Ctrl+e"]     

    if { $editable == 0 } {
        $name.m.edit entryconfigure "Edit mode" -indicatoron false 
    }

    
    ############iemlib##################


    # the put menu
    menu $name.m.put -tearoff $pd_tearoff
    $name.m add cascade -label Put -menu $name.m.put

    $name.m.put add command -label Object \
        -command [concat menu_object $name 0] \
        -accelerator [accel_munge "Ctrl+1"]

    $name.m.put add command -label Message \
        -command [concat menu_message $name 0] \
        -accelerator [accel_munge "Ctrl+2"]

    $name.m.put add command -label Number \
        -command [concat menu_floatatom $name 0] \
        -accelerator [accel_munge "Ctrl+3"]

    $name.m.put add command -label Symbol \
        -command [concat menu_symbolatom $name 0] \
        -accelerator [accel_munge "Ctrl+4"]

    $name.m.put add command -label Comment \
        -command [concat menu_comment $name 0] \
        -accelerator [accel_munge "Ctrl+5"]

    $name.m.put add separator
    
    ############iemlib##################

    $name.m.put add command -label Bang \
        -command [concat menu_bng $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+b"]
    
    $name.m.put add command -label Toggle \
        -command [concat menu_toggle $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+t"]
    
    $name.m.put add command -label Number2 \
        -command [concat menu_numbox $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+n"]
    
    $name.m.put add command -label Vslider \
        -command [concat menu_vslider $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+v"]
    
    $name.m.put add command -label Hslider \
        -command [concat menu_hslider $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+h"]
    
    $name.m.put add command -label Vradio \
        -command [concat menu_vradio $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+d"]
    
    $name.m.put add command -label Hradio \
        -command [concat menu_hradio $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+i"]
    
    $name.m.put add command -label VU \
        -command [concat menu_vumeter $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+u"]
    
    $name.m.put add command -label Canvas \
        -command [concat menu_mycnv $name 0] \
        -accelerator [accel_munge "Shift+Ctrl+c"]

    ############iemlib##################
    
    $name.m.put add separator
    
    $name.m.put add command -label Graph \
        -command [concat menu_graph $name] 

    $name.m.put add command -label Array \
        -command [concat menu_array $name] 

    # the find menu
    # Apple, Microsoft, and others put find functions in the Edit menu.
    # But in order to move these items to the Edit menu, the Find menu
    # handling needs to be dealt with, including this line in g_canvas.c:
    #         sys_vgui(".mbar.find delete %d\n", i);
    # <hans@at.or.at>
    menu $name.m.find -tearoff $pd_tearoff
    $name.m add cascade -label Find -menu $name.m.find

    $name.m.find add command -label {Find...} \
        -accelerator [accel_munge "Ctrl+f"] \
        -command [concat menu_findobject $name] 
    $name.m.find add command -label {Find Again} \
        -accelerator [accel_munge "Ctrl+g"] \
        -command [concat menu_findagain $name] 
    $name.m.find add command -label {Find last error} \
        -command [concat menu_finderror] 
    
    # the window menu
    menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \
        -tearoff $pd_tearoff

	if {$pd_nt == 2} {
		$name.m.windows add command -label {Minimize} \
			-command "menu_minimize $name" -accelerator [accel_munge "Ctrl+m"]
		$name.m.windows add command -label {Zoom} -command "menu_zoom $name"
	} else {
		$name.m.windows add command -label "Next Window" -command {menu_raisenextwindow} \
			-accelerator "Ctrl+PageDown"
		#$name.m.windows add command -label "Previous Window" -command {menu_raisepreviouswindow} \
		#	-accelerator "Ctrl+PageUp"
	}
	$name.m.windows add separator
    $name.m.windows add command -label {parent window}\
        -command [concat menu_windowparent $name] 
    $name.m.windows add command -label {Pd window} -command menu_raise_console \
		-accelerator [accel_munge "Ctrl+r"]
    $name.m.windows add separator

    # the audio menu
    menu $name.m.audio -tearoff $pd_tearoff

    if {$pd_nt != 2} {
        $name.m add cascade -label Windows -menu $name.m.windows
        $name.m add cascade -label Media -menu $name.m.audio
    } else {
        $name.m add cascade -label Media -menu $name.m.audio
        $name.m add cascade -label Window -menu $name.m.windows
        # the MacOS X app menu
        menu $name.m.apple -tearoff $pd_tearoff
        $name.m add cascade -label "Apple" -menu $name.m.apple 
    }

    # the help menu

    menu $name.m.help -tearoff $pd_tearoff
    $name.m add cascade -label Help -menu $name.m.help

    menu_addstd $name.m

    # the popup menu
    menu $name.popup -tearoff false
    $name.popup add command -label {Properties} \
        -command [concat popup_action $name 0] 
    $name.popup add command -label {Open} \
        -command [concat popup_action $name 1] 
    $name.popup add command -label {Help} \
        -command [concat popup_action $name 2] 

    # fix menu font size on Windows with tk scaling = 1
    if {$pd_nt == 1} {
        $name.m.file configure -font menuFont
        $name.m.edit configure -font menuFont
        $name.m.find configure -font menuFont
        $name.m.put configure -font menuFont
        $name.m.windows configure -font menuFont
        $name.m.audio configure -font menuFont
        $name.m.help configure -font menuFont
        $name.popup configure -font menuFont
    }

    # WM protocol
    wm protocol $name WM_DELETE_WINDOW [concat menu_close $name]

    # bindings.
    # this is idiotic -- how do you just sense what mod keys are down and
    # pass them on? I can't find it anywhere.
    # Here we encode shift as 1, control 2, alt 4, in agreement
    # with definitions in g_canvas.c.  The third button gets "8" but we don't
    # bother with modifiers there.
    # We don't handle multiple clicks yet.

    bind $name.c <Configure> { pdtk_canvas_getscroll %W }
    bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0}
    bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1}
    bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3}
    # Alt key is called Option on the Mac
    if {$pd_nt == 2} {
        bind $name.c <Option-Button> {pdtk_canvas_click %W %x %y %b 4}
        bind $name.c <Option-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
        bind $name.c <Option-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
        bind $name.c <Mod1-Button> {pdtk_canvas_click %W %x %y %b 6}
        bind $name.c <Option-Control-Shift-Button> \
            {pdtk_canvas_click %W %x %y %b 7}
    } else {
        bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4}
        bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
        bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
        bind $name.c <Alt-Control-Shift-Button> \
            {pdtk_canvas_click %W %x %y %b 7}
    }
    global pd_nt
    # button 2 is the right button on Mac; on other platforms it's button 3.
    if {$pd_nt == 2} {
        bind $name.c <Button-2> {pdtk_canvas_rightclick %W %x %y %b}
        bind $name.c <Control-Button> {pdtk_canvas_rightclick %W %x %y %b}
    } else {
        bind $name.c <Button-3> {pdtk_canvas_rightclick %W %x %y %b}
        bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
    }
    #on linux, button 2 "pastes" from the X windows clipboard
    if {$pd_nt == 0} {
        bind $name.c <Button-2> {\
                                     pdtk_canvas_click %W %x %y %b 0;\
                                     pdtk_canvas_mouseup %W %x %y %b;\
                                     pdtk_pastetext}
    }

    bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
    bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
    bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
    #    bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]}
    if {$pd_nt == 2} {
        bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
        bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
        bind $name.c <Mod1-BackSpace> {pdtk_canvas_sendkey %W 1 %K %A 0}
        bind $name.c <Mod1-quoteleft> {menu_raisenextwindow}
    } else {
        bind $name.c <Control-Next>   {menu_raisenextwindow}
        #bind $name.c <Control-Prior>  {menu_raisepreviouswindow} ;# needs Tcl/Tk 8.5
	}
    bind $name.c <Key> {pdtk_canvas_sendkey %W 1 %K %A 0}
    bind $name.c <Shift-Key> {pdtk_canvas_sendkey %W 1 %K %A 1}
    bind $name.c <KeyRelease> {pdtk_canvas_sendkey %W 0 %K %A 0}
    bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0}
    bind $name.c <Control-Motion> {pdtk_canvas_motion %W %x %y 2}
    if {$pd_nt == 2} {
        bind $name.c <Option-Motion> {pdtk_canvas_motion %W %x %y 4}
    } else { 
        bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4}
    }   
    bind $name.c <Map> {pdtk_canvas_map %W}
    bind $name.c <Unmap> {pdtk_canvas_unmap %W}
    focus $name.c

    switch $pd_nt { 0 {
        bind $name.c <Button-4>  "pdtk_canvas_scroll $name.c y -1"
        bind $name.c <Button-5>  "pdtk_canvas_scroll $name.c y +1"
        bind $name.c <Shift-Button-4>  "pdtk_canvas_scroll $name.c x -1"
        bind $name.c <Shift-Button-5>  "pdtk_canvas_scroll $name.c x +1"
    } default {
        bind $name.c  <MouseWheel> \
            "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
        bind $name.c  <Shift-MouseWheel> \
            "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
    }}

    catch {
        dnd bindtarget $name.c text/uri-list <Drop> \
            "pdtk_canvas_makeobjs $name %D %x %y"
    }

    #    puts stderr "all done"
    #   after 1 [concat raise $name]
    global pdtk_canvas_mouseup_name
    set pdtk_canvas_mouseup_name ""
}

#### jsarlo #####
proc pdtk_array_listview_setpage {arrayName page} {
    global pd_array_listview_page
    set pd_array_listview_page($arrayName) $page
}

proc pdtk_array_listview_changepage {arrayName np} {
    global pd_array_listview_page
    pdtk_array_listview_setpage \
        $arrayName [expr $pd_array_listview_page($arrayName) + $np]
    pdtk_array_listview_fillpage $arrayName
}

proc pdtk_array_listview_fillpage {arrayName} {
    global pd_array_listview_page
    global pd_array_listview_id
    set windowName [format ".%sArrayWindow" $arrayName]
    set topItem [expr [lindex [$windowName.lb yview] 0] * \
                     [$windowName.lb size]]
    
    if {[winfo exists $windowName]} {
        set cmd "$pd_array_listview_id($arrayName) \
               arrayviewlistfillpage \
               $pd_array_listview_page($arrayName) \
               $topItem"
        
        pd [concat $cmd \;]
    }
}

proc pdtk_array_listview_new {id arrayName page} {
    global pd_nt
    global pd_array_listview_page
    global pd_array_listview_id
    global fontname fontweight
    set pd_array_listview_page($arrayName) $page
    set pd_array_listview_id($arrayName) $id
    set windowName [format ".%sArrayWindow" $arrayName]
    if [winfo exists $windowName] then [destroy $windowName]
    toplevel $windowName -class DialogWindow
    wm group $windowName .
    wm protocol $windowName WM_DELETE_WINDOW \
        "pdtk_array_listview_close $id $arrayName"
    wm title $windowName [concat $arrayName "(list view)"]
    # FIXME
    set font 12
    set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
                            -selectmode extended \
                            -relief solid -background white -borderwidth 1 \
                            -font [format {{%s} %d %s} $fontname $font $fontweight]\
                            -yscrollcommand "$windowName.lb.sb set"]
    set $windowName.lb.sb [scrollbar $windowName.lb.sb \
                               -command "$windowName.lb yview" -orient vertical]
    place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
    pack $windowName.lb -expand 1 -fill both
    bind $windowName.lb <Double-ButtonPress-1> \
        "pdtk_array_listview_edit $arrayName $page $font"
    # handle copy/paste
    if {$pd_nt == 0} {
        selection handle $windowName.lb \
            "pdtk_array_listview_lbselection $arrayName"
    } else {
        if {$pd_nt == 1} {
            bind $windowName.lb <ButtonPress-3> \
                "pdtk_array_listview_popup $arrayName"
        } 
    }
    set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
                                 -command "pdtk_array_listview_changepage $arrayName -1"]
    set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
                                 -command "pdtk_array_listview_changepage $arrayName 1"]
    pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
    pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
    focus $windowName
}

proc pdtk_array_listview_lbselection {arrayName off size} {
    set windowName [format ".%sArrayWindow" $arrayName]
    set itemNums [$windowName.lb curselection]
    set cbString ""
    for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
        set listItem [$windowName.lb get [lindex $itemNums $i]]
        append cbString [string range $listItem \
                             [expr [string first ") " $listItem] + 2] \
                             end]
        append cbString "\n"
    }
    set listItem [$windowName.lb get [lindex $itemNums $i]]
    append cbString [string range $listItem \
                         [expr [string first ") " $listItem] + 2] \
                         end]
    set last $cbString
}

# Win32 uses a popup menu for copy/paste
proc pdtk_array_listview_popup {arrayName} {
    set windowName [format ".%sArrayWindow" $arrayName]
    if [winfo exists $windowName.popup] then [destroy $windowName.popup]
    menu $windowName.popup -tearoff false
    $windowName.popup add command -label {Copy} \
        -command "pdtk_array_listview_copy $arrayName; \
                  destroy $windowName.popup"
    $windowName.popup add command -label {Paste} \
        -command "pdtk_array_listview_paste $arrayName; \
                  destroy $windowName.popup"
    tk_popup $windowName.popup [winfo pointerx $windowName] \
        [winfo pointery $windowName] 0
}

proc pdtk_array_listview_copy {arrayName} {
    set windowName [format ".%sArrayWindow" $arrayName]
    set itemNums [$windowName.lb curselection]
    set cbString ""
    for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
        set listItem [$windowName.lb get [lindex $itemNums $i]]
        append cbString [string range $listItem \
                             [expr [string first ") " $listItem] + 2] \
                             end]
        append cbString "\n"
    }
    set listItem [$windowName.lb get [lindex $itemNums $i]]
    append cbString [string range $listItem \
                         [expr [string first ") " $listItem] + 2] \
                         end]
    clipboard clear
    clipboard append $cbString
}

proc pdtk_array_listview_paste {arrayName} {
    global pd_array_listview_page
    global pd_array_listview_pagesize
    set cbString [selection get -selection CLIPBOARD]
    set lbName [format ".%sArrayWindow.lb" $arrayName]
    set itemNum [lindex [$lbName curselection] 0]
    set splitChars ", \n"
    set itemString [split $cbString $splitChars]
    set flag 1
    for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
        if {[lindex $itemString $i] != {}} {
            pd [concat $arrayName [expr $itemNum + \
                                       [expr $counter + \
                                            [expr $pd_array_listview_pagesize \
                                                 * $pd_array_listview_page($arrayName)]]] \
                    [lindex $itemString $i] \;]
            incr counter
            set flag 0
        }
    }
}

proc pdtk_array_listview_edit {arrayName page font} {
    global pd_array_listview_entry
    global pd_nt
    global fontname fontweight
    set lbName [format ".%sArrayWindow.lb" $arrayName]
    if {[winfo exists $lbName.entry]} {
        pdtk_array_listview_update_entry \
            $arrayName $pd_array_listview_entry($arrayName)
        unset pd_array_listview_entry($arrayName)
    }
    set itemNum [$lbName index active]
    set pd_array_listview_entry($arrayName) $itemNum
    set bbox [$lbName bbox $itemNum]
    set y [expr [lindex $bbox 1] - 4]
    set $lbName.entry [entry $lbName.entry \
                           -font [format {{%s} %d %s} $fontname $font $fontweight]]
    $lbName.entry insert 0 []
    place configure $lbName.entry -relx 0 -y $y -relwidth 1
    lower $lbName.entry
    focus $lbName.entry
    bind $lbName.entry <Return> \
        "pdtk_array_listview_update_entry $arrayName $itemNum;"
}

proc pdtk_array_listview_update_entry {arrayName itemNum} {
    global pd_array_listview_page
    global pd_array_listview_pagesize
    set lbName [format ".%sArrayWindow.lb" $arrayName]
    set splitChars ", \n"
    set itemString [split [$lbName.entry get] $splitChars]
    set flag 1
    for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
        if {[lindex $itemString $i] != {}} {
            pd [concat $arrayName [expr $itemNum + \
                                       [expr $counter + \
                                            [expr $pd_array_listview_pagesize \
                                                 * $pd_array_listview_page($arrayName)]]] \
                    [lindex $itemString $i] \;]
            incr counter
            set flag 0
        }
    }
    pdtk_array_listview_fillpage $arrayName
    destroy $lbName.entry
}

proc pdtk_array_listview_closeWindow {arrayName} {
    set windowName [format ".%sArrayWindow" $arrayName]
    destroy $windowName
}

proc pdtk_array_listview_close {id arrayName} {
    pdtk_array_listview_closeWindow $arrayName
    set cmd [concat $id "arrayviewclose" \;]
    pd $cmd
}
##### end jsarlo #####

#################### event binding procedures ################

#get the name of the toplevel window for a canvas; this is also
#the name of the canvas object in Pd.

proc pdtk_canvas_autoscrollbars {name x y} {
    set size [$name bbox all]
    set x2 [lindex $size 2]
    set y2 [lindex $size 3]
    set rootname [winfo parent $name]
    if {$x > $x2} {pack forget $rootname.scrollhort}
    if {$y > $y2} {pack forget $rootname.scrollvert}
    if {$x < $x2} {pack $rootname.scrollhort -side bottom \
                       -fill x -before $rootname.c}
    if {$y < $y2} {pack $rootname.scrollvert -side right \
                       -fill y -before $rootname.c}
}

proc canvastosym {name} {
    string range $name 0 [expr [string length $name] - 3]
}

set pdtk_lastcanvasconfigured ""
set pdtk_lastcanvasconfiguration ""
set pdtk_lastcanvasconfiguration2 ""

proc pdtk_canvas_checkgeometry {topname} {
    set boo [winfo geometry $topname.c]
    set boo2 [wm geometry $topname]
    global pdtk_lastcanvasconfigured
    global pdtk_lastcanvasconfiguration
    global pdtk_lastcanvasconfiguration2
    if {$topname != $pdtk_lastcanvasconfigured || \
            $boo != $pdtk_lastcanvasconfiguration || \
            $boo2 != $pdtk_lastcanvasconfiguration2} {
        set pdtk_lastcanvasconfigured $topname
        set pdtk_lastcanvasconfiguration $boo
        set pdtk_lastcanvasconfiguration2 $boo2
        pd $topname relocate $boo $boo2 \;
    }
}

proc pdtk_canvas_sendclick {name x y b f} {
    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \;
}

proc pdtk_canvas_click {name x y b f} {
    focus $name
    pdtk_canvas_sendclick $name $x $y $b $f
}

proc pdtk_canvas_rightclick {name x y b} { 
    pdtk_canvas_sendclick $name $x $y $b 8
}

proc pdtk_canvas_shiftclick {name x y b} {
    pdtk_canvas_sendclick $name $x $y $b 1
}

proc pdtk_canvas_ctrlclick {name x y b} {
    pdtk_canvas_sendclick $name $x $y $b 2
}

proc pdtk_canvas_altclick {name x y b} {
    pdtk_canvas_sendclick $name $x $y $b 3
}

proc pdtk_canvas_dblclick {name x y b} {
    pdtk_canvas_sendclick $name $x $y $b 4
}

set pdtk_canvas_mouseup_name 0
set pdtk_canvas_mouseup_xminval 0
set pdtk_canvas_mouseup_xmaxval 0
set pdtk_canvas_mouseup_yminval 0
set pdtk_canvas_mouseup_ymaxval 0

proc pdtk_canvas_mouseup {name x y b} {
    pd [concat [canvastosym $name] mouseup [$name canvasx $x] \
            [$name canvasy $y] $b \;]
}

proc pdtk_canvas_getscroll {name} {
    global pdtk_canvas_mouseup_name
    global pdtk_canvas_mouseup_xminval
    global pdtk_canvas_mouseup_xmaxval
    global pdtk_canvas_mouseup_yminval
    global pdtk_canvas_mouseup_ymaxval

    #<matju> there's a bug in Tk that messes with window size while changing the cursor. trigger it seldom.
    if {[. cget -cursor] != "$::cursor_runmode_nothing"} {. configure -cursor $::cursor_runmode_nothing}
    .printout.text configure -cursor xterm

    # kludge since this gets called sometimes after a canvas is destroyed
    if {! [winfo exists $name]} {return}
    set size [$name bbox all]
    if {$size != ""} {
        set xminval 0
        set yminval 0
        set xmaxval 100
        set ymaxval 100
        set x1 [lindex $size 0]
        set x2 [lindex $size 2]
        set y1 [lindex $size 1]
        set y2 [lindex $size 3]
        
        if {$x1 < 0} {set xminval $x1}
        if {$y1 < 0} {set yminval $y1}

        if {$x2 > 100} {set xmaxval $x2}
        if {$y2 > 100} {set ymaxval $y2}

        set parentname [winfo parent $name]
        set winwidth [winfo width $parentname]
        set winheight [winfo height $parentname]
        set canvaswidth [ expr {abs($xminval)+$xmaxval} ]
        set canvasheight [ expr {abs($yminval)+$ymaxval} ]

        if {$winwidth > $canvaswidth} {pack forget $parentname.scrollhort}
        if {$winheight > $canvasheight} {pack forget $parentname.scrollvert}
        if {$winwidth < $canvaswidth} {pack $parentname.scrollhort -fill x \
                                           -side bottom -before $parentname.c}
        if {$winheight < $canvasheight} {pack $parentname.scrollvert -fill y \
                                             -side right -before $parentname.c}
        
        if {$pdtk_canvas_mouseup_name != $name || \
                $pdtk_canvas_mouseup_xminval != $xminval || \
                $pdtk_canvas_mouseup_xmaxval != $xmaxval || \
                $pdtk_canvas_mouseup_yminval != $yminval || \
                $pdtk_canvas_mouseup_ymaxval != $ymaxval } {
            
            set newsize "$xminval $yminval $xmaxval $ymaxval"
            $name configure -scrollregion $newsize
            set pdtk_canvas_mouseup_name $name
            set pdtk_canvas_mouseup_xminval $xminval
            set pdtk_canvas_mouseup_xmaxval $xmaxval
            set pdtk_canvas_mouseup_yminval $yminval
            set pdtk_canvas_mouseup_ymaxval $ymaxval
        }

    }
    pdtk_canvas_checkgeometry [canvastosym $name]
}

proc pdtk_canvas_sendkey {name state key iso shift} {
    global pd_nt
	if {$key == "BackSpace"} {
		set iso ""
		set key 8
	} elseif {$key == "Tab"} {
       set iso ""
		set key 9
	} elseif {$key == "Return"} {
        set iso ""
		set key 10
	} elseif {$key == "Escape"} {
        set iso ""
		set key 27
	} elseif {$key == "Space"} {
        set iso ""
		set key 32
	} elseif {$key == "Delete" || $key == "KP_Delete"} {
        set iso ""
		set key 127
    }
    if {$iso != ""} {
        scan $iso %c key
    }
	pd [canvastosym $name] key $state $key $shift \;
}

proc pdtk_canvas_ctrlkey {name key shift} {
    global pd_nt
    # first get rid of ".c" suffix; we'll refer to the toplevel instead
    set topname [string trimright $name .c]
    #   puts stderr [concat ctrl-key $key $topname]

    if {$key == "1"} {menu_object $topname 1}
    if {$key == "2"} {menu_message $topname 1}
    if {$key == "3"} {menu_floatatom $topname 1}
    if {$key == "4"} {menu_symbolatom $topname 1}
    if {$key == "5"} {menu_comment $topname 1}
    if {$key == "slash"} {menu_audio 1}
    if {$key == "period"} {menu_audio 0}
    if {$key == "Return"} {menu_reselect $topname}
    if {$shift == 1} {
        if {$key == "q" || $key == "Q"} {menu_really_quit}
        if {$key == "w" || $key == "W"} {menu_really_close $topname}
        if {$key == "s" || $key == "S"} {menu_saveas $topname}
        if {$key == "z" || $key == "Z"} {menu_redo $topname}
        if {$key == "b" || $key == "B"} {menu_bng $topname 1}
        if {$key == "t" || $key == "T"} {menu_toggle $topname 1}
        if {$key == "n" || $key == "N"} {menu_numbox $topname 1}
        if {$key == "v" || $key == "V"} {menu_vslider $topname 1}
        if {$key == "h" || $key == "H"} {menu_hslider $topname 1}
        if {$key == "i" || $key == "I"} {menu_hradio $topname 1}
        if {$key == "d" || $key == "D"} {menu_vradio $topname 1}
        if {$key == "u" || $key == "U"} {menu_vumeter $topname 1}
        if {$key == "c" || $key == "C"} {menu_mycnv $topname 1}
        if {$key == "l" || $key == "L"} {menu_clear_console}
        if {$key == "r" || $key == "R"} {menu_toggle_console}
    } else {
        if {$key == "e" || $key == "E"} {menu_editmode $topname}
        if {$key == "q" || $key == "Q"} {menu_quit}
        if {$key == "s" || $key == "S"} {menu_save $topname}
        if {$key == "z" || $key == "Z"} {menu_undo $topname}
        if {$key == "b" || $key == "B"} {::helpbrowser::open_helpbrowser}
        if {$key == "n" || $key == "N"} {menu_new}
        if {$key == "o" || $key == "O"} {menu_open}
        if {$key == "w" || $key == "W"} {menu_close $topname}
        if {$key == "p" || $key == "P"} {menu_print $topname}
        if {$key == "r" || $key == "R"} {menu_raise_console}
        if {$key == "x" || $key == "X"} {menu_cut $topname}
        if {$key == "c" || $key == "C"} {menu_copy $topname}
        if {$key == "v" || $key == "V"} {menu_paste $topname}
        if {$key == "d" || $key == "D"} {menu_duplicate $topname}
        if {$key == "a" || $key == "A"} {menu_selectall $topname}
        if {$pd_nt == 2} { 
			# by default, Cmd-T opens the font panel on Mac OS X
            if {$key == "t" || $key == "T"} {menu_font $topname}
			if {$key == "m" || $key == "M"} {menu_minimize $topname}
        } else {
            if {$key == "t" || $key == "T"} {menu_texteditor $topname}
			# minimize window on Mac OS X
			if {$key == "m" || $key == "M"} {menu_send}
        }
        if {$key == "f" || $key == "F"} {menu_findobject $topname}
        if {$key == "g" || $key == "G"} {menu_findagain $topname}
    }
}

proc pdtk_canvas_scroll {canvas xy distance} {
    $canvas [list $xy]view scroll $distance units
}

proc pdtk_canvas_motion {name x y mods} {
    #    puts stderr [concat [canvastosym $name] $name $x $y]
    pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $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} {
    #   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 \;
}

proc pdtk_canvas_makeobjs {name files x y} {
    set c 0
    for {set n 0} {$n < [llength $files]} {incr n} {
        if {[regexp {.*/(.+).pd$} [lindex $files $n] file obj] == 1} {
            pd $name obj $x [expr $y + ($c * 30)] [pdtk_enquote $obj] \;
            incr c
        }
    } 
}

set saveas_dir nowhere

############ pdtk_canvas_saveas -- run a saveas dialog ##############

proc pdtk_canvas_saveas {name initfile initdir} {
    global pd_nt filetypes untitled_directory
    if { ! [file isdirectory $initdir]} {set initdir $::env(HOME)}
    set filename [tk_getSaveFile -initialfile $initfile -initialdir $initdir \
					  -defaultextension .pd -filetypes $filetypes]

    if {$filename != ""} {
        # yes, we need the extent even if we're on a mac.
        if {$pd_nt == 2} {
            if {[string last .pd $filename] < 0 && \
                    [string last .PD $filename] < 0 && \
                    [string last .pat $filename] < 0 && \
                    [string last .PAT $filename] < 0} {
                set filename $filename.pd
                if {[file exists $filename]} {
                    set answer [tk_messageBox \
                                    \-message [concat overwrite $filename "?"] \
                                    \-type yesno \-icon question]
                    if {! [string compare $answer no]} {return}
                }
            }
        }

        set directory [string range $filename 0 \
                           [expr [string last / $filename ] - 1]]
        set basename [string range $filename \
                          [expr [string last / $filename ] + 1] end]
        pd [concat $name savetofile [pdtk_enquote $basename] \
                [pdtk_enquote $directory] \;]
        #       pd [concat $name savetofile $basename $directory \;]
        set untitled_directory $directory
    }
}

############ pdtk_canvas_dofont -- run a font and resize dialog #########

set fontsize 0
set dofont_fontsize 0
set stretchval 0
set whichstretch 0

proc dofont_apply {name myfontsize} {
    global stretchval
    global whichstretch
    set cmd [concat $name font $myfontsize $stretchval $whichstretch \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dofont_close {name} {
    set cmd [concat $name cancel \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dofont_cancel {name} {
    global fontsize
    dofont_apply $name $fontsize
    set cmd [concat $name cancel \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dofont_ok {name} {
    global fontsize dofont_fontsize
    set fontsize $dofont_fontsize
    dofont_apply $name $fontsize
    dofont_close $name
}

proc pdtk_canvas_dofont {name initsize} {
    global fontsize dofont_fontsize
    set fontsize $initsize
    set dofont_fontsize $initsize

    global stretchval
    set stretchval 100
    
    global whichstretch
    set whichstretch 1
    
    toplevel $name -class DialogWindow
    wm title $name  {FONT BOMB}
    wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name]

    pdtk_panelkeybindings $name dofont
    
    frame $name.buttonframe
    pack $name.buttonframe -side bottom -fill x -pady 2m
    button $name.buttonframe.cancel -text {Cancel}\
        -command "dofont_cancel $name"
    button $name.buttonframe.ok -text {OK}\
        -command "dofont_ok $name"
    pack $name.buttonframe.cancel -side left -expand 1
    pack $name.buttonframe.ok -side left -expand 1
    
    frame $name.radiof
    pack $name.radiof -side left
    
    label $name.radiof.label -text {Font Size:}
    pack $name.radiof.label -side top

    radiobutton $name.radiof.radio8 -value 8 -variable dofont_fontsize -text "8" \
        -command [concat dofont_apply $name 8]
    radiobutton $name.radiof.radio10 -value 10 -variable dofont_fontsize -text "10" \
        -command [concat dofont_apply $name 10]
    radiobutton $name.radiof.radio12 -value 12 -variable dofont_fontsize -text "12" \
        -command [concat dofont_apply $name 12]
    radiobutton $name.radiof.radio16 -value 16 -variable dofont_fontsize -text "16" \
        -command [concat dofont_apply $name 16]
    radiobutton $name.radiof.radio24 -value 24 -variable dofont_fontsize -text "24" \
        -command [concat dofont_apply $name 24]
    radiobutton $name.radiof.radio36 -value 36 -variable dofont_fontsize -text "36" \
        -command [concat dofont_apply $name 36]
    pack $name.radiof.radio8 -side top -anchor w
    pack $name.radiof.radio10 -side top -anchor w
    pack $name.radiof.radio12 -side top -anchor w
    pack $name.radiof.radio16 -side top -anchor w
    pack $name.radiof.radio24 -side top -anchor w
    pack $name.radiof.radio36 -side top -anchor w

    set current_radiobutton [format "$name.radiof.radio%d" $initsize]
    $current_radiobutton select

    frame $name.stretchf
    pack $name.stretchf -side left
    
    label $name.stretchf.label -text {Stretch:}
    pack $name.stretchf.label -side top
    
    entry $name.stretchf.entry -textvariable stretchval -width 5
    pack $name.stretchf.entry -side left

    radiobutton $name.stretchf.radio1 \
        -value 1 -variable whichstretch -text "X and Y"
    radiobutton $name.stretchf.radio2 \
        -value 2 -variable whichstretch -text "X only"
    radiobutton $name.stretchf.radio3 \
        -value 3 -variable whichstretch -text "Y only"

    pack $name.stretchf.radio1 -side top -anchor w
    pack $name.stretchf.radio2 -side top -anchor w
    pack $name.stretchf.radio3 -side top -anchor w

}

############ pdtk_gatom_dialog -- run a gatom dialog #########

# dialogs like this one can come up in many copies; but in TK the easiest
# way to get data from an "entry", etc., is to set an associated variable
# name.  This is especially true for grouped "radio buttons".  So we have
# to synthesize variable names for each instance of the dialog.  The dialog
# gets a TK pathname $id, from which it strips the leading "." to make a
# variable suffix $vid.  Then you can get the actual value out by asking for
# [eval concat $$variablename].  There should be an easier way but I don't see
# it yet.

proc gatom_escape {sym} {
    if {[string length $sym] == 0} {
        set ret "-"
        #       puts stderr [concat escape1 $sym $ret]
    } else {
        if {[string equal -length 1 $sym "-"]} {
            set ret [string replace $sym 0 0 "--"]
            #       puts stderr [concat escape $sym $ret]
        } else {
            set ret [string map {"$" "#"} $sym]
            #            puts stderr [concat unescape $sym $ret]
        }
    }
    pdtk_unspace $ret
}

proc gatom_unescape {sym} {
    if {[string equal -length 1 $sym "-"]} {
        set ret [string replace $sym 0 0 ""]
        #       puts stderr [concat unescape $sym $ret]
    } else {
        set ret [string map {"#" "$"} $sym]
        #        puts stderr [concat unescape $sym $ret]
    }
    concat $ret
}

proc dogatom_apply {id} {
    set vid [string trimleft $id .]

    set var_gatomwidth [concat gatomwidth_$vid]
    global $var_gatomwidth
    set var_gatomlo [concat gatomlo_$vid]
    global $var_gatomlo
    set var_gatomhi [concat gatomhi_$vid]
    global $var_gatomhi
    set var_gatomwherelabel [concat gatomwherelabel_$vid]
    global $var_gatomwherelabel
    set var_gatomlabel [concat gatomlabel_$vid]
    global $var_gatomlabel
    set var_gatomsymfrom [concat gatomsymfrom_$vid]
    global $var_gatomsymfrom
    set var_gatomsymto [concat gatomsymto_$vid]
    global $var_gatomsymto

    #    set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;]
    
    set cmd [concat $id param \
                 [eval concat $$var_gatomwidth] \
                 [eval concat $$var_gatomlo] \
                 [eval concat $$var_gatomhi] \
                 [eval gatom_escape $$var_gatomlabel] \
                 [eval concat $$var_gatomwherelabel] \
                 [eval gatom_escape $$var_gatomsymfrom] \
                 [eval gatom_escape $$var_gatomsymto] \
                 \;]

    #    puts stderr $cmd
    pd $cmd
}

proc dogatom_cancel {name} {
    set cmd [concat $name cancel \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dogatom_ok {name} {
    dogatom_apply $name
    dogatom_cancel $name
}

proc pdtk_gatom_dialog {id initwidth initlo inithi \
                            wherelabel label symfrom symto} {

    set vid [string trimleft $id .]

     global pd_nt

    set var_gatomwidth [concat gatomwidth_$vid]
    global $var_gatomwidth
    set var_gatomlo [concat gatomlo_$vid]
    global $var_gatomlo
    set var_gatomhi [concat gatomhi_$vid]
    global $var_gatomhi
    set var_gatomwherelabel [concat gatomwherelabel_$vid]
    global $var_gatomwherelabel
    set var_gatomlabel [concat gatomlabel_$vid]
    global $var_gatomlabel
    set var_gatomsymfrom [concat gatomsymfrom_$vid]
    global $var_gatomsymfrom
    set var_gatomsymto [concat gatomsymto_$vid]
    global $var_gatomsymto

    set $var_gatomwidth $initwidth
    set $var_gatomlo $initlo
    set $var_gatomhi $inithi
    set $var_gatomwherelabel $wherelabel
    set $var_gatomlabel [gatom_unescape $label]
    set $var_gatomsymfrom [gatom_unescape $symfrom]
    set $var_gatomsymto [gatom_unescape $symto]

    toplevel $id -class DialogWindow
    wm title $id "atom box properties"
    wm resizable $id 0 0
    wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id]

    pdtk_panelkeybindings $id "dogatom"

    frame $id.params -height 7
    pack $id.params -side top
    label $id.params.entryname -text "width"
    entry $id.params.entry -textvariable $var_gatomwidth -width 4
    pack $id.params.entryname $id.params.entry -side left

    labelframe $id.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \
        -font highlight_font
    pack $id.limits -side top -fill x
    frame $id.limits.lower
    pack $id.limits.lower -side left
    label $id.limits.lower.entryname -text "lower"
    entry $id.limits.lower.entry -textvariable $var_gatomlo -width 8
    pack $id.limits.lower.entryname $id.limits.lower.entry -side left
    frame $id.limits.upper
    pack $id.limits.upper -side left
    frame $id.limits.upper.spacer -width 20
    label $id.limits.upper.entryname -text "upper"
    entry $id.limits.upper.entry -textvariable $var_gatomhi -width 8
    pack  $id.limits.upper.spacer $id.limits.upper.entryname \
        $id.limits.upper.entry -side left

    frame $id.spacer1 -height 7
    pack $id.spacer1 -side top

    labelframe $id.label -text "label" -padx 5 -pady 4 -borderwidth 1 \
        -font highlight_font
    pack $id.label -side top -fill x
    frame $id.label.name
    pack $id.label.name -side top
    entry $id.label.name.entry -textvariable $var_gatomlabel -width 33
    pack $id.label.name.entry -side left
    frame $id.label.radio
    pack $id.label.radio -side top
    radiobutton $id.label.radio.left -value 0 \
        -variable $var_gatomwherelabel \
        -text "left   "  -justify left
    radiobutton $id.label.radio.right -value 1 \
        -variable $var_gatomwherelabel \
        -text "right" -justify left
    radiobutton $id.label.radio.top -value 2 \
        -variable $var_gatomwherelabel \
        -text "top" -justify left
    radiobutton $id.label.radio.bottom -value 3 \
        -variable $var_gatomwherelabel \
        -text "bottom" -justify left
    pack $id.label.radio.left -side left -anchor w
    pack $id.label.radio.right -side right -anchor w
    pack $id.label.radio.top -side top -anchor w
    pack $id.label.radio.bottom -side bottom -anchor w

    frame $id.spacer2 -height 7
    pack $id.spacer2 -side top

    labelframe $id.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \
        -font highlight_font
    pack $id.s_r -side top -fill x
    frame $id.s_r.paramsymto
    pack $id.s_r.paramsymto -side top -anchor e
    label $id.s_r.paramsymto.entryname -text "send symbol"
    entry $id.s_r.paramsymto.entry -textvariable $var_gatomsymto -width 21
    pack $id.s_r.paramsymto.entry $id.s_r.paramsymto.entryname -side right

    frame $id.s_r.paramsymfrom
    pack $id.s_r.paramsymfrom -side top -anchor e
    label $id.s_r.paramsymfrom.entryname -text "receive symbol"
    entry $id.s_r.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 21
    pack $id.s_r.paramsymfrom.entry $id.s_r.paramsymfrom.entryname -side right
    
    frame $id.buttonframe -pady 5
    pack $id.buttonframe -side top -fill x -pady 2m
    button $id.buttonframe.cancel -text {Cancel}\
        -command "dogatom_cancel $id"
    pack $id.buttonframe.cancel -side left -expand 1
    button $id.buttonframe.apply -text {Apply}\
        -command "dogatom_apply $id"
    pack $id.buttonframe.apply -side left -expand 1
    button $id.buttonframe.ok -text {OK}\
        -command "dogatom_ok $id"
    pack $id.buttonframe.ok -side left -expand 1

    $id.params.entry select from 0
    $id.params.entry select adjust end
    focus $id.params.entry
}

############ pdtk_canvas_popup -- popup menu for canvas #########

set popup_xpix 0
set popup_ypix 0

proc popup_action {name action} {
    global popup_xpix popup_ypix
	set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;]
	#    puts stderr $cmd
	pd $cmd
}

proc pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
    set ::popup_xpix $xcanvas
    set ::popup_ypix $ycanvas
    if {$hasproperties} {
        $mytoplevel.popup entryconfigure "Properties" -state normal
    } else {
        $mytoplevel.popup entryconfigure "Properties" -state disabled
    }
    if {$hasopen} {
        $mytoplevel.popup entryconfigure "Open" -state normal
    } else {
        $mytoplevel.popup entryconfigure "Open" -state disabled
    }
    set tkcanvas $mytoplevel.c
    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 $mytoplevel.popup $xpopup $ypopup 0
}


# begin of change "iemlib"
############ pdtk_iemgui_dialog -- dialog window for iem guis #########

set iemgui_define_min_flashhold 50
set iemgui_define_min_flashbreak 10
set iemgui_define_min_fontsize 4

proc iemgui_clip_dim {id} {
    set vid [string trimleft $id .]

    set var_iemgui_wdt [concat iemgui_wdt_$vid]
    global $var_iemgui_wdt
    set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
    global $var_iemgui_min_wdt
    set var_iemgui_hgt [concat iemgui_hgt_$vid]
    global $var_iemgui_hgt
    set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
    global $var_iemgui_min_hgt
    
    if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} {
        set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt]
        $id.dim.w_ent configure -textvariable $var_iemgui_wdt
    }
    if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} {
        set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt]
        $id.dim.h_ent configure -textvariable $var_iemgui_hgt
    }
}

proc iemgui_clip_num {id} {
    set vid [string trimleft $id .]

    set var_iemgui_num [concat iemgui_num_$vid]
    global $var_iemgui_num
    
    if {[eval concat $$var_iemgui_num] > 2000} {
        set $var_iemgui_num 2000
        $id.para.num_ent configure -textvariable $var_iemgui_num
    }
    if {[eval concat $$var_iemgui_num] < 1} {
        set $var_iemgui_num 1
        $id.para.num_ent configure -textvariable $var_iemgui_num
    }
}

proc iemgui_sched_rng {id} {
    set vid [string trimleft $id .]

    set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
    global $var_iemgui_min_rng
    set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
    global $var_iemgui_max_rng
    set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
    global $var_iemgui_rng_sch

    global iemgui_define_min_flashhold
    global iemgui_define_min_flashbreak
    
    if {[eval concat $$var_iemgui_rng_sch] == 2} {
        if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} {
            set hhh [eval concat $$var_iemgui_min_rng]
            set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng]
            set $var_iemgui_max_rng $hhh
            $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
            $id.rng.min_ent configure -textvariable $var_iemgui_min_rng }
        if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} {
            set $var_iemgui_max_rng $iemgui_define_min_flashhold
            $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
        }
        if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} {
            set $var_iemgui_min_rng $iemgui_define_min_flashbreak
            $id.rng.min_ent configure -textvariable $var_iemgui_min_rng
        }
    }
    if {[eval concat $$var_iemgui_rng_sch] == 1} {
        if {[eval concat $$var_iemgui_min_rng] == 0.0} {
            set $var_iemgui_min_rng 1.0
            $id.rng.min_ent configure -textvariable $var_iemgui_min_rng
        }
    }
}

proc iemgui_verify_rng {id} {
    set vid [string trimleft $id .]

    set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
    global $var_iemgui_min_rng
    set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
    global $var_iemgui_max_rng
    set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
    global $var_iemgui_lin0_log1
    
    if {[eval concat $$var_iemgui_lin0_log1] == 1} {
        if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} {
            set $var_iemgui_max_rng 1.0
            $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
        }
        if {[eval concat $$var_iemgui_max_rng] > 0} {
            if {[eval concat $$var_iemgui_min_rng] <= 0} {
                set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01]
                $id.rng.min_ent configure -textvariable $var_iemgui_min_rng
            }
        } else {
            if {[eval concat $$var_iemgui_min_rng] > 0} {
                set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01]
                $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
            }
        }
    }
}

proc iemgui_clip_fontsize {id} {
    set vid [string trimleft $id .]

    set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
    global $var_iemgui_gn_fs
    
    global iemgui_define_min_fontsize

    if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} {
        set $var_iemgui_gn_fs $iemgui_define_min_fontsize
        $id.label.fs_ent configure -textvariable $var_iemgui_gn_fs
    }
}

proc iemgui_set_col_example {id} {
    set vid [string trimleft $id .]

    set var_iemgui_bcol [concat iemgui_bcol_$vid]
    global $var_iemgui_bcol
    set var_iemgui_fcol [concat iemgui_fcol_$vid]
    global $var_iemgui_fcol
    set var_iemgui_lcol [concat iemgui_lcol_$vid]
    global $var_iemgui_lcol
    
    $id.colors.sections.lb_bk configure \
        -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]] \
        -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]]
    
    if { [eval concat $$var_iemgui_fcol] >= 0 } {
        $id.colors.sections.fr_bk configure \
            -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_fcol]] \
            -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]]
    } else {
        $id.colors.sections.fr_bk configure \
            -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_bcol]] \
            -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]}
}

proc iemgui_preset_col {id presetcol} {
    set vid [string trimleft $id .]

    set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
    global $var_iemgui_l2_f1_b0
    set var_iemgui_bcol [concat iemgui_bcol_$vid]
    global $var_iemgui_bcol
    set var_iemgui_fcol [concat iemgui_fcol_$vid]
    global $var_iemgui_fcol
    set var_iemgui_lcol [concat iemgui_lcol_$vid]
    global $var_iemgui_lcol
    
    if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol }
    if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol }
    if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol }
    iemgui_set_col_example $id
}

proc iemgui_choose_col_bkfrlb {id} {
    set vid [string trimleft $id .]

    set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
    global $var_iemgui_l2_f1_b0
    set var_iemgui_bcol [concat iemgui_bcol_$vid]
    global $var_iemgui_bcol
    set var_iemgui_fcol [concat iemgui_fcol_$vid]
    global $var_iemgui_fcol
    set var_iemgui_lcol [concat iemgui_lcol_$vid]
    global $var_iemgui_lcol
    
    if {[eval concat $$var_iemgui_l2_f1_b0] == 0} {
        set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC]
        set helpstring [tk_chooseColor -title "Background-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]]
        if { $helpstring != "" } {
            set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"]
            set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] }
    }
    if {[eval concat $$var_iemgui_l2_f1_b0] == 1} {
        set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC]
        set helpstring [tk_chooseColor -title "Front-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]]
        if { $helpstring != "" } {
            set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"]
            set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] }
    }
    if {[eval concat $$var_iemgui_l2_f1_b0] == 2} {
        set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC]
        set helpstring [tk_chooseColor -title "Label-Color" -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]]
        if { $helpstring != "" } {
            set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"]
            set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] }
    }
    iemgui_set_col_example $id
}

proc iemgui_lilo {id} {
    set vid [string trimleft $id .]

    set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
    global $var_iemgui_lin0_log1
    set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
    global $var_iemgui_lilo0
    set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
    global $var_iemgui_lilo1
    
    iemgui_sched_rng $id

    if {[eval concat $$var_iemgui_lin0_log1] == 0} {
        set $var_iemgui_lin0_log1 1
        $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1]
        iemgui_verify_rng $id
        iemgui_sched_rng $id
    } else {
        set $var_iemgui_lin0_log1 0
        $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0]
    }
}

proc iemgui_toggle_font {id gn_f} {
    set vid [string trimleft $id .]

    set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
    global $var_iemgui_gn_f
    global fontname fontweight
    
    set $var_iemgui_gn_f $gn_f

    switch -- $gn_f {
        0 { set current_font $fontname}
        1 { set current_font "Helvetica" }
        2 { set current_font "Times" }
    }
    set current_font_spec "{$current_font} 12 $fontweight"

    $id.label.fontpopup_label configure -text $current_font \
        -font $current_font_spec
    $id.label.name_entry configure -font $current_font_spec
    $id.colors.sections.fr_bk configure -font $current_font_spec
    $id.colors.sections.lb_bk configure -font $current_font_spec
}

proc iemgui_lb {id} {
    set vid [string trimleft $id .]

    set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
    global $var_iemgui_loadbang

    if {[eval concat $$var_iemgui_loadbang] == 0} {
        set $var_iemgui_loadbang 1
        $id.para.lb configure -text "init"
    } else {
        set $var_iemgui_loadbang 0
        $id.para.lb configure -text "no init"
    }
}

proc iemgui_stdy_jmp {id} {
    set vid [string trimleft $id .]

    set var_iemgui_steady [concat iemgui_steady_$vid]
    global $var_iemgui_steady
    
    if {[eval concat $$var_iemgui_steady]} {
        set $var_iemgui_steady 0
        $id.para.stdy_jmp configure -text "jump on click"
    } else {
        set $var_iemgui_steady 1
        $id.para.stdy_jmp configure -text "steady on click"
    }
}

proc iemgui_apply {id} {
    set vid [string trimleft $id .]

    set var_iemgui_wdt [concat iemgui_wdt_$vid]
    global $var_iemgui_wdt
    set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
    global $var_iemgui_min_wdt
    set var_iemgui_hgt [concat iemgui_hgt_$vid]
    global $var_iemgui_hgt
    set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
    global $var_iemgui_min_hgt
    set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
    global $var_iemgui_min_rng
    set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
    global $var_iemgui_max_rng
    set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
    global $var_iemgui_lin0_log1
    set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
    global $var_iemgui_lilo0
    set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
    global $var_iemgui_lilo1
    set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
    global $var_iemgui_loadbang
    set var_iemgui_num [concat iemgui_num_$vid]
    global $var_iemgui_num
    set var_iemgui_steady [concat iemgui_steady_$vid]
    global $var_iemgui_steady
    set var_iemgui_snd [concat iemgui_snd_$vid]
    global $var_iemgui_snd
    set var_iemgui_rcv [concat iemgui_rcv_$vid]
    global $var_iemgui_rcv
    set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
    global $var_iemgui_gui_nam
    set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
    global $var_iemgui_gn_dx
    set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
    global $var_iemgui_gn_dy
    set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
    global $var_iemgui_gn_f
    set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
    global $var_iemgui_gn_fs
    set var_iemgui_bcol [concat iemgui_bcol_$vid]
    global $var_iemgui_bcol
    set var_iemgui_fcol [concat iemgui_fcol_$vid]
    global $var_iemgui_fcol
    set var_iemgui_lcol [concat iemgui_lcol_$vid]
    global $var_iemgui_lcol
    
    iemgui_clip_dim $id
    iemgui_clip_num $id
    iemgui_sched_rng $id
    iemgui_verify_rng $id
    iemgui_sched_rng $id
    iemgui_clip_fontsize $id
    
    if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]}
    if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]}
    if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty"
    } else {
        set hhhgui_nam [eval concat $$var_iemgui_gui_nam]}

    if {[string index $hhhsnd 0] == "$"} {
        set hhhsnd [string replace $hhhsnd 0 0 #] }
    if {[string index $hhhrcv 0] == "$"} {
        set hhhrcv [string replace $hhhrcv 0 0 #] }
    if {[string index $hhhgui_nam 0] == "$"} {
        set hhhgui_nam [string replace $hhhgui_nam 0 0 #] }
    
    set hhhsnd [pdtk_unspace $hhhsnd]
    set hhhrcv [pdtk_unspace $hhhrcv]
    set hhhgui_nam [pdtk_unspace $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}

    pd [concat $id dialog \
            [eval concat $$var_iemgui_wdt] \
            [eval concat $$var_iemgui_hgt] \
            [eval concat $$var_iemgui_min_rng] \
            [eval concat $$var_iemgui_max_rng] \
            [eval concat $$var_iemgui_lin0_log1] \
            [eval concat $$var_iemgui_loadbang] \
            [eval concat $$var_iemgui_num] \
            $hhhsnd \
            $hhhrcv \
            $hhhgui_nam \
            [eval concat $$var_iemgui_gn_dx] \
            [eval concat $$var_iemgui_gn_dy] \
            [eval concat $$var_iemgui_gn_f] \
            [eval concat $$var_iemgui_gn_fs] \
            [eval concat $$var_iemgui_bcol] \
            [eval concat $$var_iemgui_fcol] \
            [eval concat $$var_iemgui_lcol] \
            [eval concat $$var_iemgui_steady] \
            \;]
}

proc iemgui_cancel {id} {pd [concat $id cancel \;]}

proc iemgui_ok {id} {
    iemgui_apply $id
    iemgui_cancel $id
}

proc pdtk_iemgui_dialog {id mainheader \
                             dim_header wdt min_wdt wdt_label hgt min_hgt hgt_label \
                             rng_header min_rng min_rng_label max_rng max_rng_label rng_sched \
                             lin0_log1 lilo0_label lilo1_label loadbang steady num_label num \
                             snd rcv \
                             gui_name \
                             gn_dx gn_dy \
                             gn_f gn_fs \
                             bcol fcol lcol} {

    set vid [string trimleft $id .]
    global pd_nt
    global fontname fontweight

    set var_iemgui_wdt [concat iemgui_wdt_$vid]
    global $var_iemgui_wdt
    set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
    global $var_iemgui_min_wdt
    set var_iemgui_hgt [concat iemgui_hgt_$vid]
    global $var_iemgui_hgt
    set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
    global $var_iemgui_min_hgt
    set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
    global $var_iemgui_min_rng
    set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
    global $var_iemgui_max_rng
    set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
    global $var_iemgui_rng_sch
    set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
    global $var_iemgui_lin0_log1
    set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
    global $var_iemgui_lilo0
    set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
    global $var_iemgui_lilo1
    set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
    global $var_iemgui_loadbang
    set var_iemgui_num [concat iemgui_num_$vid]
    global $var_iemgui_num
    set var_iemgui_steady [concat iemgui_steady_$vid]
    global $var_iemgui_steady
    set var_iemgui_snd [concat iemgui_snd_$vid]
    global $var_iemgui_snd
    set var_iemgui_rcv [concat iemgui_rcv_$vid]
    global $var_iemgui_rcv
    set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
    global $var_iemgui_gui_nam
    set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
    global $var_iemgui_gn_dx
    set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
    global $var_iemgui_gn_dy
    set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
    global $var_iemgui_gn_f
    set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
    global $var_iemgui_gn_fs
    set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
    global $var_iemgui_l2_f1_b0
    set var_iemgui_bcol [concat iemgui_bcol_$vid]
    global $var_iemgui_bcol
    set var_iemgui_fcol [concat iemgui_fcol_$vid]
    global $var_iemgui_fcol
    set var_iemgui_lcol [concat iemgui_lcol_$vid]
    global $var_iemgui_lcol

    set $var_iemgui_wdt $wdt
    set $var_iemgui_min_wdt $min_wdt
    set $var_iemgui_hgt $hgt
    set $var_iemgui_min_hgt $min_hgt
    set $var_iemgui_min_rng $min_rng
    set $var_iemgui_max_rng $max_rng
    set $var_iemgui_rng_sch $rng_sched
    set $var_iemgui_lin0_log1 $lin0_log1
    set $var_iemgui_lilo0 $lilo0_label
    set $var_iemgui_lilo1 $lilo1_label
    set $var_iemgui_loadbang $loadbang
    set $var_iemgui_num $num
    set $var_iemgui_steady $steady
    if {$snd == "empty"} {set $var_iemgui_snd [format ""]
    } else {set $var_iemgui_snd [format "%s" $snd]}
    if {$rcv == "empty"} {set $var_iemgui_rcv [format ""]
    } else {set $var_iemgui_rcv [format "%s" $rcv]}
    if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""]
    } else {set $var_iemgui_gui_nam [format "%s" $gui_name]}
    
    if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} {
        set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] }
    if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} {
        set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] }
    if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} {
        set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] }
    set $var_iemgui_gn_dx $gn_dx
    set $var_iemgui_gn_dy $gn_dy
    set $var_iemgui_gn_f $gn_f
    set $var_iemgui_gn_fs $gn_fs
    
    set $var_iemgui_bcol $bcol
    set $var_iemgui_fcol $fcol
    set $var_iemgui_lcol $lcol
    
    set $var_iemgui_l2_f1_b0 0

    toplevel $id -class DialogWindow
    wm title $id [format "%s Properties" $mainheader]
    wm resizable $id 0 0
    wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id]
    
    pdtk_panelkeybindings $id "iemgui"

    frame $id.dim
    pack $id.dim -side top
    label $id.dim.head -text $dim_header
    label $id.dim.w_lab -text $wdt_label -width 6
    entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5
    label $id.dim.dummy1 -text " " -width 10
    label $id.dim.h_lab -text $hgt_label -width 6
    entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5
    pack $id.dim.head -side top
    pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left
    if { $hgt_label != "empty" } {
        pack $id.dim.h_lab $id.dim.h_ent -side left}

    frame $id.rng
    pack $id.rng -side top
    label $id.rng.head -text $rng_header
    label $id.rng.min_lab -text $min_rng_label -width 6
    entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
    label $id.rng.dummy1 -text " " -width 1
    label $id.rng.max_lab -text $max_rng_label -width 8
    entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9
    if { $rng_header != "empty" } {
        pack $id.rng.head -side top
        if { $min_rng_label != "empty" } {
            pack $id.rng.min_lab $id.rng.min_ent -side left}
        if { $max_rng_label != "empty" } {
            pack $id.rng.dummy1 \
                $id.rng.max_lab $id.rng.max_ent -side left} }
    
    if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } {
        label $id.space1 -text ""
        pack $id.space1 -side top }

    frame $id.para
    pack $id.para -side top
    label $id.para.dummy2 -text "" -width 1
    label $id.para.dummy3 -text "" -width 1
    if {[eval concat $$var_iemgui_lin0_log1] == 0} {
        button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" }
    if {[eval concat $$var_iemgui_lin0_log1] == 1} {
        button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" }
    if {[eval concat $$var_iemgui_loadbang] == 0} {
        button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" }
    if {[eval concat $$var_iemgui_loadbang] == 1} {
        button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" }
    label $id.para.num_lab -text $num_label -width 9
    entry $id.para.num_ent -textvariable $var_iemgui_num -width 4
    if {[eval concat $$var_iemgui_steady] == 0} {
        button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" }
    if {[eval concat $$var_iemgui_steady] == 1} {
        button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" }
    if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
        pack $id.para.lilo -side left -expand 1}
    if {[eval concat $$var_iemgui_loadbang] >= 0} {
        pack $id.para.dummy2 $id.para.lb -side left -expand 1}
    if {[eval concat $$var_iemgui_num] > 0} {
        pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1}
    if {[eval concat $$var_iemgui_steady] >= 0} {
        pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1}

    frame $id.spacer0 -height 4
    pack $id.spacer0 -side top
    
    labelframe $id.s_r -borderwidth 1 -pady 4 -text "messages" \
        -font highlight_font
    pack $id.s_r -side top -fill x -ipadx 5
    frame $id.s_r.send
    pack $id.s_r.send -side top
    label $id.s_r.send.lab -text "   send-symbol:" -width 12  -justify right
    entry $id.s_r.send.ent -textvariable $var_iemgui_snd -width 22
    if { $snd != "nosndno" } {
        pack $id.s_r.send.lab $id.s_r.send.ent -side left}
    
    frame $id.s_r.receive
    pack $id.s_r.receive -side top
    label $id.s_r.receive.lab -text "receive-symbol:" -width 12 -justify right
    entry $id.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
    if { $rcv != "norcvno" } {
        pack $id.s_r.receive.lab $id.s_r.receive.ent -side left}
    
    # get the current font name from the int given from C-space (gn_f)
    set current_font $fontname
    if {[eval concat $$var_iemgui_gn_f] == 1} \
        { set current_font "Helvetica" }
    if {[eval concat $$var_iemgui_gn_f] == 2} \
        { set current_font "Times" }

    frame $id.spacer1 -height 7
    pack $id.spacer1 -side top
    
    labelframe $id.label -borderwidth 1 -text "label" -pady 4 \
        -font highlight_font
    pack $id.label -side top -fill x
    entry $id.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \
        -font [list $current_font 12 $fontweight]
    pack $id.label.name_entry -side top -expand yes -fill both -padx 5
    
    frame $id.label.xy -padx 27 -pady 1
    pack $id.label.xy -side top
    label $id.label.xy.x_lab -text "x offset" -width 6
    entry $id.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
    label $id.label.xy.dummy1 -text " " -width 2
    label $id.label.xy.y_lab -text "y offset" -width 6
    entry $id.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
    pack $id.label.xy.x_lab $id.label.xy.x_entry $id.label.xy.dummy1 \
        $id.label.xy.y_lab $id.label.xy.y_entry -side left -anchor e
    
    label $id.label.fontpopup_label -text $current_font \
        -relief groove -font [list $current_font 12 $fontweight] -padx 5
    pack $id.label.fontpopup_label -side left -anchor w -expand yes -fill x
    label $id.label.fontsize_label -text "size" -width 4
    entry $id.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
    pack $id.label.fontsize_entry $id.label.fontsize_label \
        -side right -anchor e -padx 5 -pady 5
    menu $id.popup
    $id.popup add command \
        -label $fontname \
        -font [format {{%s} 12 %s} $fontname $fontweight] \
        -command "iemgui_toggle_font $id 0" 
    $id.popup add command \
        -label "Helvetica" \
        -font [format {Helvetica 12 %s} $fontweight] \
        -command "iemgui_toggle_font $id 1" 
    $id.popup add command \
        -label "Times" \
        -font [format {Times 12 %s} $fontweight] \
        -command "iemgui_toggle_font $id 2" 
    bind $id.label.fontpopup_label <Button> \
        [list tk_popup $id.popup %X %Y]

    frame $id.spacer2 -height 7
    pack $id.spacer2 -side top
    
    labelframe $id.colors -borderwidth 1 -text "colors" -font highlight_font
    pack $id.colors -fill x -ipadx 5 -ipady 4
    
    frame $id.colors.select
    pack $id.colors.select -side top
    radiobutton $id.colors.select.radio0 -value 0 -variable \
        $var_iemgui_l2_f1_b0 -text "background" -width 10 -justify left
    radiobutton $id.colors.select.radio1 -value 1 -variable \
        $var_iemgui_l2_f1_b0 -text "front" -width 5 -justify left
    radiobutton $id.colors.select.radio2 -value 2 -variable \
        $var_iemgui_l2_f1_b0 -text "label" -width 5 -justify left
    if { [eval concat $$var_iemgui_fcol] >= 0 } {
        pack $id.colors.select.radio0 $id.colors.select.radio1 \
            $id.colors.select.radio2 -side left
    } else {
        pack $id.colors.select.radio0 $id.colors.select.radio2 -side left \
        }
    
    frame $id.colors.sections
    pack $id.colors.sections -side top
    button $id.colors.sections.but -text "compose color" -width 12 \
        -command "iemgui_choose_col_bkfrlb $id"
    pack $id.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
        -expand yes -fill x
    if { [eval concat $$var_iemgui_fcol] >= 0 } {
        label $id.colors.sections.fr_bk -text "o=||=o" -width 6 \
            -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_fcol]] \
            -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
            -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge
    } else {
        label $id.colors.sections.fr_bk -text "o=||=o" -width 6 \
            -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_bcol]] \
            -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
            -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge
    }
    label $id.colors.sections.lb_bk -text "testlabel" -width 9 \
        -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]] \
        -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
        -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge
    pack $id.colors.sections.lb_bk $id.colors.sections.fr_bk \
        -side right -anchor e -expand yes -fill both -pady 7

    # color scheme by Mary Ann Benedetto http://piR2.org
    frame $id.colors.r1
    pack $id.colors.r1 -side top
    foreach i { 0 1 2 3 4 5 6 7 8 9} \
        hexcol { 0xFFFFFF 0xDFDFDF 0xBBBBBB 0xFFC7C6 0xFFE3C6 \
                     0xFEFFC6 0xC6FFC7 0xc6FEFF 0xC7C6FF 0xE3C6FF } \
        {
            label $id.colors.r1.c$i -background [format "#%6.6x" $hexcol] \
                -activebackground [format "#%6.6x" $hexcol] -relief ridge \
                -padx 7 -pady 0
            bind $id.colors.r1.c$i <Button> [format "iemgui_preset_col %s %d" $id $hexcol] 
        }
    pack $id.colors.r1.c0 $id.colors.r1.c1 $id.colors.r1.c2 $id.colors.r1.c3 \
        $id.colors.r1.c4 $id.colors.r1.c5 $id.colors.r1.c6 $id.colors.r1.c7 \
        $id.colors.r1.c8 $id.colors.r1.c9 -side left
    
    frame $id.colors.r2
    pack $id.colors.r2 -side top
    foreach i { 0 1 2 3 4 5 6 7 8 9 } \
        hexcol { 0x9F9F9F 0x7C7C7C 0x606060 0xFF0400 0xFF8300 \
                     0xFAFF00 0x00FF04 0x00FAFF 0x0400FF 0x9C00FF } \
        {
            label $id.colors.r2.c$i -background [format "#%6.6x" $hexcol] \
                -activebackground [format "#%6.6x" $hexcol] -relief ridge \
                -padx 7 -pady 0
            bind  $id.colors.r2.c$i <Button> \
                [format "iemgui_preset_col %s %d" $id $hexcol] 
        }
    pack $id.colors.r2.c0 $id.colors.r2.c1 $id.colors.r2.c2 $id.colors.r2.c3 \
        $id.colors.r2.c4 $id.colors.r2.c5 $id.colors.r2.c6 $id.colors.r2.c7 \
        $id.colors.r2.c8 $id.colors.r2.c9 -side left
    
    frame $id.colors.r3
    pack $id.colors.r3 -side top
    foreach i { 0 1 2 3 4 5 6 7 8 9 } \
        hexcol { 0x404040 0x202020 0x000000 0x551312 0x553512 \
                     0x535512 0x0F4710 0x0E4345 0x131255 0x2F004D } \
        {
            label $id.colors.r3.c$i -background [format "#%6.6x" $hexcol] \
                -activebackground [format "#%6.6x" $hexcol] -relief ridge \
                -padx 7 -pady 0
            bind  $id.colors.r3.c$i <Button> \
                [format "iemgui_preset_col %s %d" $id $hexcol] 
        }
    pack $id.colors.r3.c0 $id.colors.r3.c1 $id.colors.r3.c2 $id.colors.r3.c3 \
        $id.colors.r3.c4 $id.colors.r3.c5 $id.colors.r3.c6 $id.colors.r3.c7 \
        $id.colors.r3.c8 $id.colors.r3.c9 -side left
    
    frame $id.cao -pady 10
    pack $id.cao -side top
    button $id.cao.cancel -text {Cancel} -width 6 \
        -command "iemgui_cancel $id"
    label $id.cao.dummy1 -text "" -width 3
    button $id.cao.apply -text {Apply} -width 6 -command "iemgui_apply $id"
    label $id.cao.dummy2 -text "" -width 3
    button $id.cao.ok -text {OK} -width 6 \
        -command "iemgui_ok $id"
    
    pack $id.cao.cancel $id.cao.dummy1 -side left
    pack $id.cao.apply $id.cao.dummy2 -side left
    pack $id.cao.ok -side left

 #   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]}
 #   }
    
#    $id.dim.w_ent select from 0
#    $id.dim.w_ent select adjust end
#    focus $id.dim.w_ent
}
# end of change "iemlib"

############ pdtk_array_dialog -- dialog window for arrays #########
# see comments above (pdtk_gatom_dialog) about variable name handling 

proc array_apply {id} {
    # strip "." from the TK id to make a variable name suffix 
    set vid [string trimleft $id .]
    # for each variable, make a local variable to hold its name...
    set var_array_name [concat array_name_$vid]
    global $var_array_name
    set var_array_n [concat array_n_$vid]
    global $var_array_n
    set var_array_saveit [concat array_saveit_$vid]
    global $var_array_saveit
    set var_array_drawasrects [concat array_drawasrects_$vid]
    global $var_array_drawasrects
    set var_array_otherflag [concat array_otherflag_$vid]
    global $var_array_otherflag
    set mofo [eval concat $$var_array_name]
    if {[string index $mofo 0] == "$"} {
        set mofo [string replace $mofo 0 0 #] }

    set saveit [eval concat $$var_array_saveit]
    set drawasrects [eval concat $$var_array_drawasrects]

    pd [concat $id arraydialog $mofo \
            [eval concat $$var_array_n] \
            [expr $saveit + 2 * $drawasrects] \
            [eval concat $$var_array_otherflag] \
            \;]
}

# jsarlo
proc array_viewlist {id} {
    pd [concat $id arrayviewlistnew\;]
}
# end jsarlo

proc array_cancel {id} {
    set cmd [concat $id cancel \;]
    pd $cmd
}

proc array_ok {id} {
    array_apply $id
    array_cancel $id
}

proc pdtk_array_dialog {id name n flags newone} {
    set vid [string trimleft $id .]

    set var_array_name [concat array_name_$vid]
    global $var_array_name
    set var_array_n [concat array_n_$vid]
    global $var_array_n
    set var_array_saveit [concat array_saveit_$vid]
    global $var_array_saveit
    set var_array_drawasrects [concat array_drawasrects_$vid]
    global $var_array_drawasrects
    set var_array_otherflag [concat array_otherflag_$vid]
    global $var_array_otherflag

    set $var_array_name $name
    set $var_array_n $n
    set $var_array_saveit [expr ( $flags & 1 ) != 0]
    set $var_array_drawasrects [expr ( $flags & 2 ) != 0]
    set $var_array_otherflag 0

    toplevel $id -class DialogWindow
    wm title $id {array}
    wm resizable $id 0 0
    wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id]

    pdtk_panelkeybindings $id "array"

    frame $id.name
    pack $id.name -side top
    label $id.name.label -text "name"
    entry $id.name.entry -textvariable $var_array_name
    pack $id.name.label $id.name.entry -side left

    frame $id.n
    pack $id.n -side top
    label $id.n.label -text "size"
    entry $id.n.entry -textvariable $var_array_n
    pack $id.n.label $id.n.entry -side left

    checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \
        -anchor w
    pack $id.saveme -side top

    frame $id.drawasrects
    pack $id.drawasrects -side top
    radiobutton $id.drawasrects.drawasrects0 -value 0 \
        -variable $var_array_drawasrects \
        -text "draw as points"
    radiobutton $id.drawasrects.drawasrects1 -value 1 \
        -variable $var_array_drawasrects \
        -text "polygon"
    radiobutton $id.drawasrects.drawasrects2 -value 2 \
        -variable $var_array_drawasrects \
        -text "bezier curve"
    pack $id.drawasrects.drawasrects0 -side top -anchor w
    pack $id.drawasrects.drawasrects1 -side top -anchor w
    pack $id.drawasrects.drawasrects2 -side top -anchor w

    if {$newone != 0} {
        frame $id.radio
        pack $id.radio -side top
        radiobutton $id.radio.radio0 -value 0 \
            -variable $var_array_otherflag \
            -text "in new graph"
        radiobutton $id.radio.radio1 -value 1 \
            -variable $var_array_otherflag \
            -text "in last graph"
        pack $id.radio.radio0 -side top -anchor w
        pack $id.radio.radio1 -side top -anchor w
    } else {    
        checkbutton $id.deleteme -text {delete me} \
            -variable $var_array_otherflag -anchor w
        pack $id.deleteme -side top
    }
    # jsarlo
    if {$newone == 0} {
      button $id.listview -text {View list}\
        -command "array_viewlist $id"
      pack $id.listview -side left
    }
    # end jsarlo
    frame $id.buttonframe
    pack $id.buttonframe -side bottom -fill x -pady 2m
    button $id.buttonframe.cancel -text {Cancel}\
        -command "array_cancel $id"
    if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\
        -command "array_apply $id"}
    button $id.buttonframe.ok -text {OK}\
        -command "array_ok $id"
    pack $id.buttonframe.cancel -side left -expand 1
    if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1}
    pack $id.buttonframe.ok -side left -expand 1
    
    $id.name.entry select from 0
    $id.name.entry select adjust end
    focus $id.name.entry
}

############ pdtk_canvas_dialog -- dialog window for canvass #########
# see comments above (pdtk_gatom_dialog) about variable name handling 

proc canvas_apply {id} {
    # strip "." from the TK id to make a variable name suffix 
    set vid [string trimleft $id .]
    # for each variable, make a local variable to hold its name...

    set var_canvas_xscale [concat canvas_xscale_$vid]
    global $var_canvas_xscale
    set var_canvas_yscale [concat canvas_yscale_$vid]
    global $var_canvas_yscale
    set var_canvas_graphme [concat canvas_graphme_$vid]
    global $var_canvas_graphme
    set var_canvas_hidetext [concat canvas_hidetext_$vid]
    global $var_canvas_hidetext
    set var_canvas_x1 [concat canvas_x1_$vid]
    global $var_canvas_x1
    set var_canvas_x2 [concat canvas_x2_$vid]
    global $var_canvas_x2
    set var_canvas_xpix [concat canvas_xpix_$vid]
    global $var_canvas_xpix
    set var_canvas_xmargin [concat canvas_xmargin_$vid]
    global $var_canvas_xmargin
    set var_canvas_y1 [concat canvas_y1_$vid]
    global $var_canvas_y1
    set var_canvas_y2 [concat canvas_y2_$vid]
    global $var_canvas_y2
    set var_canvas_ypix [concat canvas_ypix_$vid]
    global $var_canvas_ypix
    set var_canvas_ymargin [concat canvas_ymargin_$vid]
    global $var_canvas_ymargin

    pd [concat $id donecanvasdialog \
            [eval concat $$var_canvas_xscale] \
            [eval concat $$var_canvas_yscale] \
            [expr [eval concat $$var_canvas_graphme]+2*[eval concat $$var_canvas_hidetext]] \
            [eval concat $$var_canvas_x1] \
            [eval concat $$var_canvas_y1] \
            [eval concat $$var_canvas_x2] \
            [eval concat $$var_canvas_y2] \
            [eval concat $$var_canvas_xpix] \
            [eval concat $$var_canvas_ypix] \
            [eval concat $$var_canvas_xmargin] \
            [eval concat $$var_canvas_ymargin] \
            \;]
}

proc canvas_cancel {id} {
    set cmd [concat $id cancel \;]
    pd $cmd
}

proc canvas_ok {id} {
    canvas_apply $id
    canvas_cancel $id
}

proc canvas_checkcommand {id} {
    set vid [string trimleft $id .]
    #    puts stderr [concat canvas_checkcommand $id $vid]

    set var_canvas_xscale [concat canvas_xscale_$vid]
    global $var_canvas_xscale
    set var_canvas_yscale [concat canvas_yscale_$vid]
    global $var_canvas_yscale
    set var_canvas_graphme [concat canvas_graphme_$vid]
    global $var_canvas_graphme
    set var_canvas_hidetext [concat canvas_hidetext_$vid]
    global $var_canvas_hidetext
    set var_canvas_x1 [concat canvas_x1_$vid]
    global $var_canvas_x1
    set var_canvas_x2 [concat canvas_x2_$vid]
    global $var_canvas_x2
    set var_canvas_xpix [concat canvas_xpix_$vid]
    global $var_canvas_xpix
    set var_canvas_xmargin [concat canvas_xmargin_$vid]
    global $var_canvas_xmargin
    set var_canvas_y1 [concat canvas_y1_$vid]
    global $var_canvas_y1
    set var_canvas_y2 [concat canvas_y2_$vid]
    global $var_canvas_y2
    set var_canvas_ypix [concat canvas_ypix_$vid]
    global $var_canvas_ypix
    set var_canvas_ymargin [concat canvas_ymargin_$vid]
    global $var_canvas_ymargin

    if { [eval concat $$var_canvas_graphme] != 0 } {
        $id.hidetext configure -state normal
        $id.xrange.entry1 configure -state normal
        $id.xrange.entry2 configure -state normal
        $id.xrange.entry3 configure -state normal
        $id.xrange.entry4 configure -state normal
        $id.yrange.entry1 configure -state normal
        $id.yrange.entry2 configure -state normal
        $id.yrange.entry3 configure -state normal
        $id.yrange.entry4 configure -state normal
        $id.xscale.entry configure -state disabled
        $id.yscale.entry configure -state disabled
        set x1 [eval concat $$var_canvas_x1]
        set y1 [eval concat $$var_canvas_y1]
        set x2 [eval concat $$var_canvas_x2]
        set y2 [eval concat $$var_canvas_y2]
        if { [eval concat $$var_canvas_x1] == 0 && \
                 [eval concat $$var_canvas_y1] == 0 && \
                 [eval concat $$var_canvas_x2] == 0 && \
                 [eval concat $$var_canvas_y2] == 0 } {
            set $var_canvas_x2 1
            set $var_canvas_y2 1
        }
        if { [eval concat $$var_canvas_xpix] == 0 } {
            set $var_canvas_xpix 85
            set $var_canvas_xmargin 100
        }
        if { [eval concat $$var_canvas_ypix] == 0 } {
            set $var_canvas_ypix 60
            set $var_canvas_ymargin 100
        }
    } else {
        $id.hidetext configure -state disabled
        $id.xrange.entry1 configure -state disabled
        $id.xrange.entry2 configure -state disabled
        $id.xrange.entry3 configure -state disabled
        $id.xrange.entry4 configure -state disabled
        $id.yrange.entry1 configure -state disabled
        $id.yrange.entry2 configure -state disabled
        $id.yrange.entry3 configure -state disabled
        $id.yrange.entry4 configure -state disabled
        $id.xscale.entry configure -state normal
        $id.yscale.entry configure -state normal
        if { [eval concat $$var_canvas_xscale] == 0 } {
            set $var_canvas_xscale 1
        }
        if { [eval concat $$var_canvas_yscale] == 0 } {
            set $var_canvas_yscale -1
        }
    }
}

proc pdtk_canvas_dialog {id xscale yscale graphme x1 y1 x2 y2 \
                             xpix ypix xmargin ymargin} {
    set vid [string trimleft $id .]

    set var_canvas_xscale [concat canvas_xscale_$vid]
    global $var_canvas_xscale
    set var_canvas_yscale [concat canvas_yscale_$vid]
    global $var_canvas_yscale
    set var_canvas_graphme [concat canvas_graphme_$vid]
    global $var_canvas_graphme
    set var_canvas_hidetext [concat canvas_hidetext_$vid]
    global $var_canvas_hidetext
    set var_canvas_x1 [concat canvas_x1_$vid]
    global $var_canvas_x1
    set var_canvas_x2 [concat canvas_x2_$vid]
    global $var_canvas_x2
    set var_canvas_xpix [concat canvas_xpix_$vid]
    global $var_canvas_xpix
    set var_canvas_xmargin [concat canvas_xmargin_$vid]
    global $var_canvas_xmargin
    set var_canvas_y1 [concat canvas_y1_$vid]
    global $var_canvas_y1
    set var_canvas_y2 [concat canvas_y2_$vid]
    global $var_canvas_y2
    set var_canvas_ypix [concat canvas_ypix_$vid]
    global $var_canvas_ypix
    set var_canvas_ymargin [concat canvas_ymargin_$vid]
    global $var_canvas_ymargin

    set $var_canvas_xscale $xscale
    set $var_canvas_yscale $yscale
    set $var_canvas_graphme [expr ($graphme!=0)?1:0]
    set $var_canvas_hidetext [expr ($graphme&2)?1:0]
    set $var_canvas_x1 $x1
    set $var_canvas_y1 $y1
    set $var_canvas_x2 $x2
    set $var_canvas_y2 $y2
    set $var_canvas_xpix $xpix
    set $var_canvas_ypix $ypix
    set $var_canvas_xmargin $xmargin
    set $var_canvas_ymargin $ymargin

    toplevel $id -class DialogWindow
    wm title $id {canvas}
    wm protocol $id WM_DELETE_WINDOW [concat canvas_cancel $id]

    pdtk_panelkeybindings $id "canvas"

    label $id.toplabel -text "Canvas Properties"
    pack $id.toplabel -side top
    
    frame $id.xscale
    pack $id.xscale -side top
    label $id.xscale.label -text "X units per pixel"
    entry $id.xscale.entry -textvariable $var_canvas_xscale -width 10
    pack $id.xscale.label $id.xscale.entry -side left

    frame $id.yscale
    pack $id.yscale -side top
    label $id.yscale.label -text "Y units per pixel"
    entry $id.yscale.entry -textvariable $var_canvas_yscale -width 10
    pack $id.yscale.label $id.yscale.entry -side left

    checkbutton $id.graphme -text {graph on parent} \
        -variable $var_canvas_graphme -anchor w \
        -command [concat canvas_checkcommand $id]
    pack $id.graphme -side top

    checkbutton $id.hidetext -text {hide object name and arguments} \
        -variable $var_canvas_hidetext -anchor w \
        -command [concat canvas_checkcommand $id]
    pack $id.hidetext -side top

    frame $id.xrange
    pack $id.xrange -side top
    label $id.xrange.label1 -text "X range: from"
    entry $id.xrange.entry1 -textvariable $var_canvas_x1 -width 6
    label $id.xrange.label2 -text "to"
    entry $id.xrange.entry2 -textvariable $var_canvas_x2 -width 6
    label $id.xrange.label3 -text "size"
    entry $id.xrange.entry3 -textvariable $var_canvas_xpix -width 4
    label $id.xrange.label4 -text "margin"
    entry $id.xrange.entry4 -textvariable $var_canvas_xmargin -width 4
    pack $id.xrange.label1 $id.xrange.entry1 \
        $id.xrange.label2 $id.xrange.entry2 \
        $id.xrange.label3 $id.xrange.entry3 \
        $id.xrange.label4 $id.xrange.entry4 \
        -side left

    frame $id.yrange
    pack $id.yrange -side top
    label $id.yrange.label1 -text "Y range: from"
    entry $id.yrange.entry1 -textvariable $var_canvas_y1 -width 6
    label $id.yrange.label2 -text "to"
    entry $id.yrange.entry2 -textvariable $var_canvas_y2 -width 6
    label $id.yrange.label3 -text "size"
    entry $id.yrange.entry3 -textvariable $var_canvas_ypix -width 4
    label $id.yrange.label4 -text "margin"
    entry $id.yrange.entry4 -textvariable $var_canvas_ymargin -width 4
    pack $id.yrange.label1 $id.yrange.entry1 \
        $id.yrange.label2 $id.yrange.entry2 \
        $id.yrange.label3 $id.yrange.entry3 \
        $id.yrange.label4 $id.yrange.entry4 \
        -side left

    frame $id.buttonframe
    pack $id.buttonframe -side bottom -fill x -pady 2m
    button $id.buttonframe.cancel -text {Cancel}\
        -command "canvas_cancel $id"
    button $id.buttonframe.apply -text {Apply}\
        -command "canvas_apply $id"
    button $id.buttonframe.ok -text {OK}\
        -command "canvas_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

    $id.xscale.entry select from 0
    $id.xscale.entry select adjust end
    focus $id.xscale.entry
    canvas_checkcommand $id
}

############ pdtk_data_dialog -- run a data dialog #########
proc dodata_send {name} {
    #    puts stderr [$name.text get 0.0 end]

    for {set i 1} {[$name.text compare [concat $i.0 + 3 chars] < end]} \
        {incr i 1} {
            #       puts stderr [concat it's [$name.text get $i.0 [expr $i + 1].0]]
            set cmd [concat $name data [$name.text get $i.0 [expr $i + 1].0] \;]
            #       puts stderr $cmd
            pd $cmd
        }
    set cmd [concat $name end \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dodata_cancel {name} {
    set cmd [concat $name cancel \;]
    #    puts stderr $cmd
    pd $cmd
}

proc dodata_ok {name} {
    dodata_send $name
    dodata_cancel $name
}

proc pdtk_data_dialog {name stuff} {
    global pd_deffont
    toplevel $name -class DialogWindow
    wm title $name {Atom}
    wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name]

    pdtk_panelkeybindings $name "dodata"
    bind $name <Control-t> [concat dodata_ok $name]
    bind $name <Control-s> [concat dodata_send $name]

    frame $name.buttonframe
    pack $name.buttonframe -side bottom -fill x -pady 2m
    button $name.buttonframe.send -text {Send (Ctrl s)}\
        -command [concat dodata_send $name]
    button $name.buttonframe.ok -text {OK (Ctrl t)}\
        -command [concat dodata_ok $name]
    pack $name.buttonframe.send -side left -expand 1
    pack $name.buttonframe.ok -side left -expand 1

    text $name.text -relief raised -bd 2 -height 40 -width 60 \
        -yscrollcommand "$name.scroll set" -font $pd_deffont
    scrollbar $name.scroll -command "$name.text yview"
    pack $name.scroll -side right -fill y
    pack $name.text -side left -fill both -expand 1
    $name.text insert end $stuff
    focus $name.text
}

############ check or uncheck the "edit" menu item ##############
#####################iemlib#######################
proc pdtk_canvas_editval {name value} {
    if { $value } {
        $name.m.edit entryconfigure "Edit mode" -indicatoron true
    } else {                          
        $name.m.edit entryconfigure "Edit mode" -indicatoron false
    }                                                 
}
#####################iemlib#######################

############ pdtk_text_new -- create a new text object #2###########
proc pdtk_text_new {canvasname myname x y text font color} {
    #    if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]}
    #    if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]}

    global pd_fontlist pd_nt
    switch -- $font {
        8  { set typeface [lindex $pd_fontlist 0] }
        9  { set typeface [lindex $pd_fontlist 1] }
        10 { set typeface [lindex $pd_fontlist 2] }
        12 { set typeface [lindex $pd_fontlist 3] }
        14 { set typeface [lindex $pd_fontlist 4] }
        16 { set typeface [lindex $pd_fontlist 5] }
        18 { set typeface [lindex $pd_fontlist 6] }
        24 { set typeface [lindex $pd_fontlist 7] }
        30 { set typeface [lindex $pd_fontlist 8] }
        36 { set typeface [lindex $pd_fontlist 9] }
    }

    $canvasname create text $x $y -font $typeface \
        -tags $myname -text $text -fill $color -anchor nw 
	$canvasname bind $myname <Home> [concat $canvasname icursor $myname 0]
	$canvasname bind $myname <End> [concat $canvasname icursor $myname end]
	if {$pd_nt == 2} { # emacs bindings for Mac OS X
		$canvasname bind $myname <Control-a> \
			[concat $canvasname icursor $myname 0]
		$canvasname bind $myname <Control-e> \
			[concat $canvasname icursor $myname end]
	}
    #    pd [concat $myname size [$canvasname bbox $myname] \;]
}

################ pdtk_text_set -- change the text ##################
proc pdtk_text_set {canvasname myname text} {
    $canvasname itemconfig $myname -text $text
    #    pd [concat $myname size [$canvasname bbox $myname] \;]
}

############### event binding procedures for Pd window ################

proc pdtk_pd_ctrlkey {name key shift} {
	global pd_nt
    #    puts stderr [concat key $key shift $shift]
    #    .dummy itemconfig goo -text [concat ---> control-key event $key];
    if {$shift == 1} {
        if {$key == "l" || $key == "L"} {menu_clear_console}
        if {$key == "q" || $key == "Q"} {menu_really_quit}
        if {$key == "r" || $key == "R"} {menu_toggle_console}
    } else {
        if {$key == "b" || $key == "B"} {::helpbrowser::open_helpbrowser}
        if {$key == "n" || $key == "N"} {menu_new}
        if {$key == "o" || $key == "O"} {menu_open}
        if {$key == "q" || $key == "Q"} {menu_quit}
        if {$key == "r" || $key == "R"} {menu_raise_console}
        if {$pd_nt != 2} {
            # Cmd-m is minimize window on Mac OS X
            if {$key == "m" || $key == "M"} {menu_send}
		} else {
            if {$key == "m" || $key == "M"} {menu_minimize}
		}
        if {$key == "slash"} {menu_audio 1}
        if {$key == "period"} {menu_audio 0}
	}
}

######### startup function.  ##############
# Tell pd the current directory; this is used in case the command line
# asked pd to open something.  Also, get character width and height for
# seven "useful" font sizes.

# tb: user defined typefaces
proc pdtk_pd_startup {version apilist midiapilist fontname_from_pd fontweight_from_pd} {
    #    puts stderr [concat $version $apilist $fontname]
    global pd_myversion pd_apilist pd_midiapilist pd_nt
    set pd_myversion $version
    set pd_apilist $apilist
    set pd_midiapilist $midiapilist
    global fontname fontweight
    set fontname $fontname_from_pd
    set fontweight $fontweight_from_pd
    global pd_fontlist
    set pd_fontlist {}
	
	# on Mac OS X, lower the Pd window to the background so patches open on top
	if {$pd_nt == 2} { lower . }
	# on Windows, raise the Pd window so that it has focused when launched
	if {$pd_nt == 1} { raise . }

    set fontlist ""
	if {$pd_nt != 1 && $::tcl_version eq "8.5"} {
		set sizelist "5 6 8 9 10 12 14 16 19 25"
	} else {
		set sizelist "8 9 10 12 14 16 18 24 30 36"
	}
    foreach i $sizelist {
        set font [format {{%s} %d %s} $fontname_from_pd $i $fontweight_from_pd]
        set pd_fontlist [linsert $pd_fontlist 100000 $font] 
        set width0 [font measure  $font x]
        set height0 [lindex [font metrics $font] 5]
        set fontlist [concat $fontlist $i [font measure  $font x] \
                          [lindex [font metrics $font] 5]]
    }

    set tclpatch [info patchlevel]
    if {$tclpatch == "8.3.0" || \
            $tclpatch == "8.3.1" || \
            $tclpatch == "8.3.2" || \
            $tclpatch == "8.3.3" } {
        set oldtclversion 1
    } else {
        set oldtclversion 0
    }
    pd [concat pd init [pdtk_enquote [pwd]] $oldtclversion $fontlist \;];

    # 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 

    global pd_nt
    if {$pd_nt == 2} {
        global pd_macdropped pd_macready
        set pd_macready 1
        foreach file $pd_macdropped {
            . configure -cursor watch
            .printout.text configure -cursor watch
            menu_doc_open [file dirname $file] [file tail $file]
        }
    }
}

##################### DSP ON/OFF, METERS, DIO ERROR ###################
proc pdtk_pd_dsp {value} {
    global ctrls_audio_on
    if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0}
    #    puts stderr [concat its $ctrls_audio_on]
}

proc pdtk_pd_meters {indb outdb inclip outclip} {
    #    puts stderr [concat meters $indb $outdb $inclip $outclip]
    global ctrls_inlevel ctrls_outlevel
    set ctrls_inlevel $indb
    if {$inclip == 1} {
        .controls.inout.in.clip configure -background red
    } else {
        .controls.inout.in.clip configure -background grey
    }
    set ctrls_outlevel $outdb
    if {$outclip == 1} {
        .controls.inout.out.clip configure -background red
    } else {
        .controls.inout.out.clip configure -background grey
    }
    
}

proc pdtk_pd_dio {red} {
#    puts stderr [concat dio $red]
    if {$red == 1} {
        .controls.dio configure -background red -activebackground red
    } else {
        .controls.dio configure -background grey -activebackground lightgrey
    }
        
}

############# text editing from the "edit" menu ###################
set edit_number 1

proc texteditor_send {name} {
    set topname [string trimright $name .text]
    for {set i 0} \
        {[$name compare [concat 0.0 + [expr $i + 1] chars] < end]} \
            {incr i 1} {
        set cha [$name get [concat 0.0 + $i chars]]
        scan $cha %c keynum
        pd [concat pd key 1 $keynum 0 \;]
    }
}

proc texteditor_ok {name} {
    set topname [string trimright $name .text]
    texteditor_send $name
    destroy $topname
}


proc pdtk_pd_texteditor {stuff} {
    global edit_number pd_deffont
    set name [format ".text%d" $edit_number]
    set edit_number [expr $edit_number + 1]

    toplevel $name -class DialogWindow
    wm title $name {TEXT}

    pdtk_standardkeybindings $name
    bind $name <Control-t> {texteditor_ok %W}
    bind $name <Control-s> {texteditor_send %W}

    frame $name.buttons
    pack $name.buttons -side bottom -fill x -pady 2m
    button $name.buttons.send -text {Send (Ctrl s)}\
        -command "texteditor_send $name.text"
    button $name.buttons.ok -text {OK (Ctrl t)}\
        -command "texteditor_ok $name.text"
    pack $name.buttons.send -side left -expand 1
    pack $name.buttons.ok -side left -expand 1

    text $name.text -relief raised -bd 2 -height 12 -width 60 \
        -yscrollcommand "$name.scroll set" -font $pd_deffont
    scrollbar $name.scroll -command "$name.text yview"
    pack $name.scroll -side right -fill y
    pack $name.text -side left -fill both -expand 1
    $name.text insert end $stuff
    focus $name.text
}

#  paste text into a text box
proc pdtk_pastetext {} {
    global pdtk_pastebuffer
    set pdtk_pastebuffer ""
    catch {global pdtk_pastebuffer; set pdtk_pastebuffer [clipboard get]}
#    puts stderr [concat paste $pdtk_pastebuffer]
    for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
        set cha [string index $pdtk_pastebuffer $i]
        scan $cha %c keynum
        pd [concat pd key 1 $keynum 0 \;]
    }
}

############# open and save dialogs for objects in Pd ##########

proc pdtk_openpanel {target localdir} {
    global pd_opendir
    if {$localdir == ""} {
      set localdir $pd_opendir
    }
    set filename [tk_getOpenFile -initialdir $localdir]
    if {$filename != ""} {
        set directory [string range $filename 0 \
            [expr [string last / $filename ] - 1]]
        set pd_opendir $directory

        pd [concat $target callback [pdtk_enquote $filename] \;]
    }
}

proc pdtk_savepanel {target localdir} {
    global pd_savedir
    if {$localdir == ""} {
      set localdir $pd_savedir
    }
    set filename [tk_getSaveFile -initialdir $localdir]
    if {$filename != ""} {
        pd [concat $target callback [pdtk_enquote $filename] \;]
    }
}

########################### comport hack ########################

set com1 0
set com2 0
set com3 0
set com4 0

proc com1_open {} {
    global com1
    set com1 [open com1 w]
    .dummy itemconfig goo -text $com1
    fconfigure $com1 -buffering none
    fconfigure $com1 -mode 19200,e,8,2
}

proc com1_send {str} {
    global com1
    puts -nonewline $com1 $str
}


############# start a polling process to watch the socket ##############
# this is needed for nt, and presumably for Mac as well.
# in UNIX this is handled by a tcl callback (set up in t_tkcmd.c)

if {$pd_nt == 1} {
    proc polleofloop {} {
        pd_pollsocket
        after 20 polleofloop
    }

    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_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

    pd [concat pd audio-dialog \
        $audio_indev1 \
        $audio_indev2 \
        $audio_indev3 \
        $audio_indev4 \
        [expr $audio_inchan1 * ( $audio_inenable1 ? 1 : -1 ) ]\
        [expr $audio_inchan2 * ( $audio_inenable2 ? 1 : -1 ) ]\
        [expr $audio_inchan3 * ( $audio_inenable3 ? 1 : -1 ) ]\
        [expr $audio_inchan4 * ( $audio_inenable4 ? 1 : -1 ) ]\
        $audio_outdev1 \
        $audio_outdev2 \
        $audio_outdev3 \
        $audio_outdev4 \
        [expr $audio_outchan1 * ( $audio_outenable1 ? 1 : -1 ) ]\
        [expr $audio_outchan2 * ( $audio_outenable2 ? 1 : -1 ) ]\
        [expr $audio_outchan3 * ( $audio_outenable3 ? 1 : -1 ) ]\
        [expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
        $audio_sr \
        $audio_advance \
        $audio_callback \
        \;]
}

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} {
    global pd_nt
    if [winfo exists $name.popup] {destroy $name.popup}
    menu $name.popup -tearoff false
    if {$pd_nt == 1} {
    $name.popup configure -font menuFont
    }
#    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 indev1 indev2 indev3 indev4 \
        inchan1 inchan2 inchan3 inchan4 \
        outdev1 outdev2 outdev3 outdev4 \
        outchan1 outchan2 outchan3 outchan4 sr advance multi callback \
        longform} {
    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_indevlist audio_outdevlist
    global pd_indev pd_outdev

    set audio_indev1 $indev1
    set audio_indev2 $indev2
    set audio_indev3 $indev3
    set audio_indev4 $indev4

    set audio_inchan1 [expr ( $inchan1 > 0 ? $inchan1 : -$inchan1 ) ]
    set audio_inenable1 [expr $inchan1 > 0 ]
    set audio_inchan2 [expr ( $inchan2 > 0 ? $inchan2 : -$inchan2 ) ]
    set audio_inenable2 [expr $inchan2 > 0 ]
    set audio_inchan3 [expr ( $inchan3 > 0 ? $inchan3 : -$inchan3 ) ]
    set audio_inenable3 [expr $inchan3 > 0 ]
    set audio_inchan4 [expr ( $inchan4 > 0 ? $inchan4 : -$inchan4 ) ]
    set audio_inenable4 [expr $inchan4 > 0 ]

    set audio_outdev1 $outdev1
    set audio_outdev2 $outdev2
    set audio_outdev3 $outdev3
    set audio_outdev4 $outdev4

    set audio_outchan1 [expr ( $outchan1 > 0 ? $outchan1 : -$outchan1 ) ]
    set audio_outenable1 [expr $outchan1 > 0 ]
    set audio_outchan2 [expr ( $outchan2 > 0 ? $outchan2 : -$outchan2 ) ]
    set audio_outenable2 [expr $outchan2 > 0 ]
    set audio_outchan3 [expr ( $outchan3 > 0 ? $outchan3 : -$outchan3 ) ]
    set audio_outenable3 [expr $outchan3 > 0 ]
    set audio_outchan4 [expr ( $outchan4 > 0 ? $outchan4 : -$outchan4 ) ]
    set audio_outenable4 [expr $outchan4 > 0 ]

    set audio_sr $sr
    set audio_advance $advance
    set audio_callback $callback
    toplevel $id -class DialogWindow
    wm group $id .
    wm title $id {audio}
    wm protocol $id WM_DELETE_WINDOW [concat audio_cancel $id]

    pdtk_panelkeybindings $id "audio"

    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"
    button $id.buttonframe.save -text {Save all settings}\
        -command "audio_apply $id \; pd pd save-preferences \\;"
    pack $id.buttonframe.cancel $id.buttonframe.apply $id.buttonframe.ok \
        $id.buttonframe.save -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
    if {$audio_callback >= 0} {
        checkbutton $id.srf.x3 -variable audio_callback \
            -text {use callbacks} -anchor e
        pack $id.srf.x3 -side left
    }
        # input device 1
    frame $id.in1f
    pack $id.in1f -side top

    checkbutton $id.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

        # input device 2
    if {$longform && $multi > 1 && [llength $audio_indevlist] > 1} {
        frame $id.in2f
        pack $id.in2f -side top

        checkbutton $id.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 \
                $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
    }

        # input device 3
    if {$longform && $multi > 1 && [llength $audio_indevlist] > 2} {
        frame $id.in3f
        pack $id.in3f -side top

        checkbutton $id.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 \
                $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
    }

        # input device 4
    if {$longform && $multi > 1 && [llength $audio_indevlist] > 3} {
        frame $id.in4f
        pack $id.in4f -side top

        checkbutton $id.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 \
                $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
    }

        # output device 1
    frame $id.out1f
    pack $id.out1f -side top

    checkbutton $id.out1f.x0 -variable audio_outenable1 \
        -text {output device 1} -anchor e
    if {$multi == 0} {
        label $id.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 \
                $audio_outdevlist]
    }
    label $id.out1f.l2 -text "channels:"
    entry $id.out1f.x2 -textvariable audio_outchan1 -width 3
    if {$multi == 0} {
        pack $id.out1f.x0 $id.out1f.l1 $id.out1f.x2 -side left
    } else {
        pack $id.out1f.x0 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left
    }

        # output device 2
    if {$longform && $multi > 1 && [llength $audio_outdevlist] > 1} {
        frame $id.out2f
        pack $id.out2f -side top

        checkbutton $id.out2f.x0 -variable audio_outenable2 \
            -text {output device 2} -anchor e
        button $id.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
    }

        # output device 3
    if {$longform && $multi > 1 && [llength $audio_outdevlist] > 2} {
        frame $id.out3f
        pack $id.out3f -side top

        checkbutton $id.out3f.x0 -variable audio_outenable3 \
            -text {output device 3} -anchor e
        button $id.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
    }

        # output device 4
    if {$longform && $multi > 1 && [llength $audio_outdevlist] > 3} {
        frame $id.out4f
        pack $id.out4f -side top

        checkbutton $id.out4f.x0 -variable audio_outenable4 \
            -text {output device 4} -anchor e
        button $id.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
    }

        # 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
    }
    $id.srf.x1 select from 0
    $id.srf.x1 select adjust end
    focus $id.srf.x1
}

####################### midi dialog ##################

proc midi_apply {id} {
    global midi_indev1 midi_indev2 midi_indev3 midi_indev4 
    global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
    global midi_alsain midi_alsaout

    pd [concat pd midi-dialog \
        $midi_indev1 \
        $midi_indev2 \
        $midi_indev3 \
        $midi_indev4 \
        $midi_outdev1 \
        $midi_outdev2 \
        $midi_outdev3 \
        $midi_outdev4 \
        $midi_alsain \
        $midi_alsaout \
        \;]
}

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} {
    global pd_nt
    if [winfo exists $name.popup] {destroy $name.popup}
    menu $name.popup -tearoff false
    if {$pd_nt == 1} {
    $name.popup configure -font menuFont
    }
#    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 indev1 indev2 indev3 indev4 \
        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
    global midi_alsain midi_alsaout

    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_alsain [llength $midi_indevlist]
    set midi_alsaout [llength $midi_outdevlist]

    toplevel $id -class DialogWindow
    wm title $id {midi}
    wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id]

    pdtk_panelkeybindings $id "midi"

    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 $midi_indevlist $midi_indev1] \
        -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
    pack $id.in1f.l1 $id.in1f.x1 -side left

        # input device 2
    if {$longform && [llength $midi_indevlist] > 2} {
        frame $id.in2f
        pack $id.in2f -side top

        label $id.in2f.l1 -text "input device 2:"
        button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
            -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
                $midi_indevlist]
        pack $id.in2f.l1 $id.in2f.x1 -side left
    }

        # input device 3
    if {$longform && [llength $midi_indevlist] > 3} {
        frame $id.in3f
        pack $id.in3f -side top

        label $id.in3f.l1 -text "input device 3:"
        button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
            -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
                $midi_indevlist]
        pack $id.in3f.l1 $id.in3f.x1 -side left
    }

        # input device 4
    if {$longform && [llength $midi_indevlist] > 4} {
        frame $id.in4f
        pack $id.in4f -side top

        label $id.in4f.l1 -text "input device 4:"
        button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
            -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
                $midi_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 $midi_outdevlist $midi_outdev1] \
        -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
            $midi_outdevlist]
    pack $id.out1f.l1 $id.out1f.x1 -side left

        # output device 2
    if {$longform && [llength $midi_outdevlist] > 2} {
        frame $id.out2f
        pack $id.out2f -side top
        label $id.out2f.l1 -text "output device 2:"
        button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
            -command \
            [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
        pack $id.out2f.l1 $id.out2f.x1 -side left
    }

        # output device 3
    if {$longform && [llength $midi_midi_outdevlist] > 3} {
        frame $id.out3f
        pack $id.out3f -side top
        label $id.out3f.l1 -text "output device 3:"
        button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
            -command \
            [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
        pack $id.out3f.l1 $id.out3f.x1 -side left
    }

        # output device 4
    if {$longform && [llength $midi_midi_outdevlist] > 4} {
        frame $id.out4f
        pack $id.out4f -side top
        label $id.out4f.l1 -text "output device 4:"
        button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
            -command \
            [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_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
    }
}

proc pdtk_alsa_midi_dialog {id indev1 indev2 indev3 indev4 \
        outdev1 outdev2 outdev3 outdev4 longform alsa} {
    global midi_indev1 midi_indev2 midi_indev3 midi_indev4 
    global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
    global midi_indevlist midi_outdevlist
    global midi_alsain midi_alsaout

    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_alsain [llength $midi_indevlist]
    set midi_alsaout [llength $midi_outdevlist]
    
    toplevel $id
    wm group $id .
    wm title $id {midi}
    wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id]

    pdtk_panelkeybindings $id "midi"

    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

    frame $id.in1f
    pack $id.in1f -side top

  if {$alsa == 0} {
        # input device 1
    label $id.in1f.l1 -text "input device 1:"
    button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
        -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
    pack $id.in1f.l1 $id.in1f.x1 -side left

        # input device 2
    if {$longform && [llength $midi_indevlist] > 2} {
        frame $id.in2f
        pack $id.in2f -side top

        label $id.in2f.l1 -text "input device 2:"
        button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
            -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
                $midi_indevlist]
        pack $id.in2f.l1 $id.in2f.x1 -side left
    }

        # input device 3
    if {$longform && [llength $midi_indevlist] > 3} {
        frame $id.in3f
        pack $id.in3f -side top

        label $id.in3f.l1 -text "input device 3:"
        button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
            -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
                $midi_indevlist]
        pack $id.in3f.l1 $id.in3f.x1 -side left
    }

        # input device 4
    if {$longform && [llength $midi_indevlist] > 4} {
        frame $id.in4f
        pack $id.in4f -side top

        label $id.in4f.l1 -text "input device 4:"
        button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
            -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
                $midi_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 $midi_outdevlist $midi_outdev1] \
        -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
            $midi_outdevlist]
    pack $id.out1f.l1 $id.out1f.x1 -side left

        # output device 2
    if {$longform && [llength $midi_outdevlist] > 2} {
        frame $id.out2f
        pack $id.out2f -side top
        label $id.out2f.l1 -text "output device 2:"
        button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
            -command \
            [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
        pack $id.out2f.l1 $id.out2f.x1 -side left
    }

        # output device 3
    if {$longform && [llength $midi_outdevlist] > 3} {
        frame $id.out3f
        pack $id.out3f -side top
        label $id.out3f.l1 -text "output device 3:"
        button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
            -command \
            [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
        pack $id.out3f.l1 $id.out3f.x1 -side left
    }

        # output device 4
    if {$longform && [llength $midi_outdevlist] > 4} {
        frame $id.out4f
        pack $id.out4f -side top
        label $id.out4f.l1 -text "output device 4:"
        button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
            -command \
            [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_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 alsa devices} \
            -command  {pd pd midi-properties 1 \;}
        pack $id.longbutton.b
    }
    }
    if {$alsa} {
        label $id.in1f.l1 -text "In Ports:"
        entry $id.in1f.x1 -textvariable midi_alsain -width 4
        pack $id.in1f.l1 $id.in1f.x1 -side left
        label $id.in1f.l2 -text "Out Ports:"
        entry $id.in1f.x2 -textvariable midi_alsaout -width 4
        pack $id.in1f.l2 $id.in1f.x2 -side left
    }
}


############ namespace ScrollBox -- utility scrollbar with default bindings #########
# This ScrollBox is used in the Path and Startup dialogs to edit lists of options

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 get_curidx { id } {
        set idx [$id.listbox.box index active]
        if {$idx < 0 || \
            $idx == [$id.listbox.box index end]} {
            return [expr {[$id.listbox.box index end] + 1}]
        }
        return [expr $idx]
    }

    proc insert_item { id idx name } {
        if {$name != ""} {
            $id.listbox.box insert $idx $name
            set activeIdx [expr {[$id.listbox.box index active] + 1}]
            $id.listbox.box see $activeIdx
            $id.listbox.box activate $activeIdx
            $id.listbox.box selection clear 0 end
            $id.listbox.box selection set active
            focus $id.listbox.box
        }
    }

    proc add_item { id add_method } {
        set dir [$add_method]
        insert_item $id [expr {[get_curidx $id] + 1}] $dir
    }

    proc edit_item { id edit_method } {
        set idx [expr {[get_curidx $id]}]
        set initialValue [$id.listbox.box get $idx]
        if {$initialValue != ""} {
            set dir [$edit_method $initialValue]

            if {$dir != ""} {
                $id.listbox.box delete $idx
                insert_item $id $idx $dir
            }
            $id.listbox.box activate $idx
            $id.listbox.box selection clear 0 end
            $id.listbox.box selection set active
            focus $id.listbox.box
        }
    }

    proc delete_item { id } {
        set cursel [$id.listbox.box curselection]
        foreach idx $cursel {
            $id.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 dbl_click { id edit_method add_method x y } {
        if { $x == "" || $y == "" } {
            return
        }

        set curBB [$id.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 $id $add_method
        } else {
            edit_item $id $edit_method
        }
    }

    proc click { id x y } {
        # record the index of the current element being
        # clicked on
        set ::lastIdx [$id.listbox.box index @$x,$y]

        focus $id.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 release { id x y } {
        set curIdx [$id.listbox.box index @$x,$y]

        if { $curIdx != $::lastIdx } {
            # clear any current selection
            $id.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
            }

            $id.listbox.box insert $newIdx [$id.listbox.box get $::lastIdx]
            $id.listbox.box delete $oldIdx
            $id.listbox.box activate $newIdx
            $id.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 make { id listdata add_method edit_method } {
        global pd_nt
        frame $id.listbox
        listbox $id.listbox.box \
            -selectmode browse -activestyle dotbox \
            -yscrollcommand [list "$id.listbox.scrollbar" set]

        # Create a scrollbar and keep it in sync with the current
        # listbox view
        pack $id.listbox.box [scrollbar "$id.listbox.scrollbar" \
                -command [list $id.listbox.box yview]] \
                -side left -fill y -anchor w 

        # Populate the listbox widget
        foreach item $listdata {
            $id.listbox.box insert end $item
        }

        # Standard listbox key/mouse bindings
        event add <<Delete>> <Delete>
        if { $pd_nt == 2 } { event add <<Delete>> <BackSpace> }

        bind $id.listbox.box <ButtonPress> "ScrollBox::click $id %x %y"
        bind $id.listbox.box <Double-1> "ScrollBox::dbl_click $id $edit_method $add_method %x %y"
        bind $id.listbox.box <ButtonRelease> "ScrollBox::release $id %x %y"
        bind $id.listbox.box <Return> "ScrollBox::edit_item $id $edit_method"
        bind $id.listbox.box <<Delete>> "ScrollBox::delete_item $id"

        # <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 $id <Configure> "$id.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 $id.listbox.box -side left -fill both -expand 1
        pack $id.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 $id.actions 
        pack $id.actions -side top -padx 2m -fill x 
        button $id.actions.add_path -text {New...} \
            -command "ScrollBox::add_item $id $add_method"
        button $id.actions.edit_path -text {Edit...} \
            -command "ScrollBox::edit_item $id $edit_method"
        button $id.actions.delete_path -text {Delete} \
            -command "ScrollBox::delete_item $id"

        pack $id.actions.delete_path -side right -pady 2m
        pack $id.actions.edit_path -side right -pady 2m
        pack $id.actions.add_path -side right -pady 2m

        $id.listbox.box activate end
        $id.listbox.box selection set end
        focus $id.listbox.box
    }
}



############ namespace dlg_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
namespace eval dlg_ScrollBoxWindow {
    proc get_listdata { id } {
        return [$id.listbox.box get 0 end]
    }

    proc do_apply { id commit_method listdata } {
        $commit_method [pdtk_encode $listdata]
        pd "pd save-preferences \;"
    }

    # Cancel button action
    proc cancel { id } {
        pd [concat $id cancel \;]
    }

    # Apply button action
    proc apply { id commit_method } {
        do_apply $id $commit_method [get_listdata $id]
    }

    # 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 ok { id commit_method } {
        set listdata [get_listdata $id]
        cancel $id
        do_apply $id $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 make { id listdata add_method edit_method commit_method title width height } {
        toplevel $id -class DialogWindow
        wm title $id $title
        wm protocol $id WM_DELETE_WINDOW [concat dlg_ScrollBoxWindow::cancel $id]

        # Enforce a minimum size for the window
        wm minsize $id $width $height

        # Set the current dimensions of the window
        wm geometry $id "${width}x${height}"
		
        # Center the window on the screen
        after idle "center_window $id"

        # Add the scrollbox widget
        ScrollBox::make $id $listdata $add_method $edit_method

        # Use two frames for the buttons, since we want them both
        # bottom and right
        frame $id.nb
        pack $id.nb -side bottom -fill x -pady 2m

        frame $id.nb.buttonframe
        pack $id.nb.buttonframe -side right -padx 2m

        button $id.nb.buttonframe.cancel -text {Cancel}\
            -command "dlg_ScrollBoxWindow::cancel $id"
        button $id.nb.buttonframe.apply -text {Apply}\
            -command "dlg_ScrollBoxWindow::apply $id $commit_method"
        button $id.nb.buttonframe.ok -text {OK}\
            -command "dlg_ScrollBoxWindow::ok $id $commit_method"

        pack $id.nb.buttonframe.cancel -side left -expand 1 -padx 2m
        pack $id.nb.buttonframe.apply -side left -expand 1 -padx 2m
        pack $id.nb.buttonframe.ok -side left -expand 1 -padx 2m
   }
}


############ pdtk_path_dialog -- dialog window for search path #########
namespace eval dlg_Path {
    proc choosePath { curValue title } {
        if {! [file exist $curValue] } {set curValue "~"}
        return [tk_chooseDirectory -initialdir $curValue -title $title]
    }

    proc add {} {
        return [dlg_Path::choosePath "" {Add a new path}]
    }

    proc edit { curValue } {
        return [dlg_Path::choosePath $curValue "Edit existing path \[$curValue\]"]
    }

    proc commit { new_path } {
        global pd_extrapath pd_verbose
        global pd_path
        set pd_path $new_path

        pd [concat pd path-dialog $pd_extrapath $pd_verbose $pd_path \;]
    }

    proc init { id extrapath verbose } {
        global pd_extrapath pd_verbose
        global pd_path

        set pd_extrapath $extrapath
        set pd_verbose $verbose

        dlg_ScrollBoxWindow::make $id $pd_path \
            dlg_Path::add dlg_Path::edit dlg_Path::commit \
            {PD search path for patches and other files} \
            400 300 

        frame $id.extraframe
        pack $id.extraframe -side bottom -pady 2m
        checkbutton $id.extraframe.extra -text {use standard extensions} \
            -variable pd_extrapath -anchor w 
        checkbutton $id.extraframe.verbose -text {verbose} \
            -variable pd_verbose -anchor w 
        pack $id.extraframe.extra $id.extraframe.verbose \
            -side left -expand 1
    }
}

proc pdtk_path_dialog { id extrapath verbose } {
    dlg_Path::init $id $extrapath $verbose
}


########## pdtk_startup_dialog -- dialog window for startup options #########
namespace eval dlg_Startup {
    # Create a simple modal window with an entry widget
    # for editing/adding a startup command 
    # (the next-best-thing to in-place editing)
    proc chooseCommand { prompt initialValue } {
        global cmd
        set cmd $initialValue

        toplevel .inputBox
        wm title .inputBox $prompt
        wm minsize .inputBox 450 30
        wm resizable .inputBox 1 0
        wm geom .inputBox "450x30"
        after idle { center_window .inputBox 10 50 }

        button .inputBox.cmdOK -text "OK" -command { destroy .inputBox }

        entry .inputBox.txtInput -width 50 -textvariable cmd 
        pdtk_standardkeybindings .inputBox.txtInput
        bind .inputBox.txtInput <KeyPress-Return> { destroy .inputBox }
        bind .inputBox.txtInput <KeyPress-Escape> { destroy .inputBox }
        pack .inputBox.txtInput -side left -expand 1 -fill x -padx 2m
        pack .inputBox.cmdOK -side left 

        focus .inputBox.txtInput

        grab .inputBox
        raise .inputBox
        wm transient .inputBox
        tkwait window .inputBox

        return $cmd
    }

    proc add {} {
        return [chooseCommand {Add new startup command} ""]
    }

    proc edit { curValue } {
        return [chooseCommand {Edit startup command} $curValue]
    }

    proc commit { new_startup } {
        global pd_nort pd_flags
        global pd_startup
        set pd_startup $new_startup

        pd [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] $pd_startup \;]
    }

    proc init { id nort flags } {
        global pd_nort pd_nt pd_flags
        global pd_startup

        set pd_nort $nort
        set pd_flags $flags

        dlg_ScrollBoxWindow::make $id $pd_startup \
            dlg_Startup::add dlg_Startup::edit dlg_Startup::commit \
            {PD binaries to load (on next startup)} \
            400 300

        label $id.entryname -text {startup flags:}
        entry $id.entry -textvariable pd_flags -width 60
        pdtk_standardkeybindings $id.entry
        pack $id.entryname $id.entry -side left
        pack $id.entry -side right -padx 2m -fill x -expand 1

        frame $id.nortframe
        pack $id.nortframe -side bottom -fill x -pady 2m
        if {$pd_nt != 1} {
            checkbutton $id.nortframe.nort -text {defeat real-time scheduling} \
                -variable pd_nort -anchor w
        }
   }
}

proc pdtk_startup_dialog {id nort flags} {
    dlg_Startup::init $id $nort $flags
}

