[PD-cvs] SF.net SVN: pure-data:[10458] branches/pd-devel/0.41.4/src/pd.tk

23 Dec 2008

Revision: 10458
          http://pure-data.svn.sourceforge.net/pure-data/?rev=10458&view=rev
Author:   eighthave
Date:     2008-12-23 08:18:58 +0000 (Tue, 23 Dec 2008)
Log Message:
-----------
- replaced copy of u_main.tk with a start from scratch
- outlined init and main functions
- outlined building menus
Modified Paths:
--------------
    branches/pd-devel/0.41.4/src/pd.tk
Modified: branches/pd-devel/0.41.4/src/pd.tk
===================================================================

--- branches/pd-devel/0.41.4/src/pd.tk	2008-12-23 06:27:37 UTC (rev 10457)
+++ branches/pd-devel/0.41.4/src/pd.tk	2008-12-23 08:18:58 UTC (rev 10458)
@@ -1,4397 +1,152 @@
 #!/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##########
+package require Tk
+#package require tile
-# 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 defaultFontFamily {Bitstream Vera Sans Mono}
-    set defaultFontWeight normal
-    font create menuFont -family Tahoma -size -11
-} elseif { $tcl_platform(os) == "Darwin" } {  
-    set pd_nt 2
-    set defaultFontFamily Monaco
-    set defaultFontWeight normal
-} else { 
-    set pd_nt 0
-    set defaultFontFamily Courier
-    set defaultFontWeight bold
-}        
+## replace Tk widgets with Ttk widgets on 8.5
+#namespace import -force ttk::*
-# start Pd-extended font hacks -----------------------------
+# ------------------------------------------------------------------------------
+# init functions
-# 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
-
-# this font is for the Pd Window console text
-font create console_font -family $defaultFontFamily -size -12 \
-    -weight $defaultFontWeight
-# 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 -----------------------------
-
-
-# Tearoff is set to true by default:
-set pd_tearoff 1
-
-# 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
-
-if {$pd_nt == 1} {
-    global pd_guidir
-    global pd_tearoff
-    set pd_gui2 [string range $argv0 0 [expr [string last \ $argv0 ] - 1]]
-    regsub -all \\ $pd_gui2 / pd_gui3
-    set pd_guidir $pd_gui3/..
-    load $pd_guidir/bin/pdtcl.dll
-    set pd_tearoff 1
+proc init_x11 {} {
 }
-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 2
-    global pd_guidir
-    global pd_tearoff
-    set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]]
-    set pd_guidir $pd_gui2/..
-    load $pd_guidir/bin/libPdTcl.dylib
-    set pd_tearoff 0
-    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} {
-                pd [concat pd open [pdtk_enquote [file tail $file]] \
-                    [pdtk_enquote  [file dirname $file]] ;]
-                    menu_doc_open [file dirname $file] [file tail $file]
-            } else {
-                set pd_macdropped $args
-            }
-        }
-    }
+proc init_aqua {} {
 }
-# 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 .
-    }
+proc init_win32 {} {
+    font create menufont -family Tahoma -size -11
 }
-set pd_deffont {courier 12 bold}
-
-set help_top_directory $pd_guidir/doc
-
-# it's unfortunate but we seem to have to turn off global bindings
-# for Text objects to get control-s and control-t to do what we want for
-# "text" dialogs below.  Also we have to get rid of tab's changing the focus.
-
-bind all <Key-Tab> ""
-bind all <<PrevWindow>> ""
-bind Text <Control-t> {}
-bind Text <Control-s> {}
-# puts stderr [bind all]
-
-################## 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
-canvas .dummy -height 2p -width 6c
-
-frame .controls
-pack .controls .dummy -side top -fill x
-menu .mbar.file -tearoff $pd_tearoff
-.mbar add cascade -label "File" -menu .mbar.file
-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
+proc init {} {
+	if { [tk windowingsystem] eq "x11" } { 
+	} elseif { [tk windowingsystem] eq "aqua" }  {
+	} elseif { [tk windowingsystem] eq "win32" } { 
+	}
 }
-# fix menu font size on Windows with tk scaling = 1
-if {$pd_nt == 1} {
-    .mbar.file configure -font menuFont
-    .mbar.find configure -font menuFont
-    .mbar.windows configure -font menuFont
-    .mbar.audio configure -font menuFont
-    .mbar.help configure -font menuFont
-}
+# ------------------------------------------------------------------------------
+# Mac OS X specific functions
-set ctrls_audio_on 0
-set ctrls_meter_on 0
-set ctrls_inlevel 0
-set ctrls_outlevel 0
+# ------------------------------------------------------------------------------
+# functions called from menu items
-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 ;]}
-
-pack .controls.switches.audiobutton .controls.switches.meterbutton \
-     -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 accel_munge {thingy} {
 }
-proc pdtk_standardkeybindings {id} {
-    global pd_nt
-    bind $id <Control-Key> {pdtk_pd_ctrlkey %W %K 0}
-    bind $id <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1}
-    if {$pd_nt == 2} {
-        bind $id <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
-        bind $id <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
-    }
+proc menu_doc_open {docdir doc} {
 }
-pdtk_standardkeybindings .
-
-wm title . "Pd"
-. configure -menu .mbar -width 200 -height 150
-
-# Intercept closing the main pd window: MP 20060413:
-wm protocol . WM_DELETE_WINDOW menu_quit
-
-############### set up global variables ################################
-
-set untitled_number 1
-set untitled_directory [pwd]
-set saveas_client doggy
-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
+proc menu_doc_browser {dir} {
 }
-#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
+# ------------------------------------------------------------------------------
+# menu building functions
+proc menu_create_file {rootmenu} {
+#	$rootmenu add command -label New -command {menu_new} 
+	$rootmenu add command -label New -command {pdtk_canvas_new .flarg 30 10} \
+		-accelerator [accel_munge "Ctrl+n"]
+	$rootmenu add command -label Open -command {menu_open} \
+		-accelerator [accel_munge "Ctrl+o"]
+	$rootmenu add  separator
+	$rootmenu add command -label Message -command {menu_send} \
+		-accelerator [accel_munge "Ctrl+m"]
+	# On MacOS X, these are in the standard HIG locations
+	# i.e. the Preferences menu under "Pd"
+	if {[tk windowingsystem] ne "aqua"} {
+		$rootmenu add command -label Path... \
+			-command {pd pd start-path-dialog ;}
+		$rootmenu add command -label Startup... \
+			-command {pd pd start-startup-dialog ;}
+	}
+	$rootmenu add  separator
+	$rootmenu add command -label Quit -command {menu_quit} \
+		-accelerator [accel_munge "Ctrl+q"]
 }
-#enquote a string for preferences (command strings etc.)
-proc pdtk_encodedialog {x} {
-    concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
+proc menu_create_edit {rootmenu} {
 }
-proc pdtk_debug {x} {
-    tk_messageBox -message $x -type ok
+proc menu_create_put {rootmenu} {
 }
-proc pdtk_watchdog {} {
-    pd [concat pd watchdog ;]
-    after 2000 {pdtk_watchdog}
+proc menu_create_media {rootmenu} {
 }
-proc pdtk_ping {} {
-    pd [concat pd ping ;]
+proc menu_create_window {rootmenu} {
 }
-##### routine to ask user if OK and, if so, send a message on to Pd ######
-proc pdtk_check {x message default} {
-    set answer [tk_messageBox -message $x -type yesno -default $default \
-        -icon question]
-    if {! [string compare $answer yes]}  {pd $message}
-}
-
-set menu_windowlist {} 
-
-proc pdtk_fixwindowmenu {} {
-    global menu_windowlist
-    .mbar.windows delete 0 end
-    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
-    pd [concat pd filename Untitled-$untitled_number $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
-    set filename [tk_getOpenFile -defaultextension .pd \
-        -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \
-        -initialdir $pd_opendir]
-    if {$filename != ""} {open_file $filename}
-}
-
-proc open_file {filename} {
-    global pd_opendir
-    set directory [string range $filename 0 [expr [string last / $filename] - 1]]
-    set pd_opendir $directory
-    set basename [string range $filename [expr [string last / $filename] + 1] end]
-    if {[string last .pd $filename] >= 0} {
-        pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
-    }
-}
-
-catch {
-    package require tkdnd
-    dnd bindtarget . text/uri-list <Drop> {
-        foreach file %D {open_file $file}
-    }
-}
-
-################## the "Message" menu command #########################
-proc menu_send {} {
-    toplevel .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.entry <KeyPress-Return> {
-        pd [concat $send_textvariable ;]
-    }
-    pdtk_standardkeybindings .sendpanel.entry
-    focus .sendpanel.entry
-}
-
-################## the "Quit" menu command #########################
-proc menu_really_quit {} {pd {pd quit;}}
-
-proc menu_quit {} {pd {pd verifyquit;}}
-
-######### the "Pd" menu command, which puts the Pd window on top ########
-proc menu_pop_pd {} {raise .}
-
-######### the "audio" menu command  ###############
-proc menu_audio {flag} {pd [concat pd dsp $flag ;]}
-
-######### 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
-    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
-    
-    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]} {
-                         puts stderr [format "%s %s" $browser $filename]
-                         exec -- sh -c [format "%s %s" $browser $filename] &
-                         break
-                     }
-                 }
-    } elseif {$pd_nt == 2} {
-        puts stderr [format "open %s" $filename]
-            exec sh -c [format "open %s" $filename]
-    } else {
-        exec rundll32 url.dll,FileProtocolHandler \
-            [format "file://%s" $filename] &
-    }
-}
-
-proc menu_doc_open {subdir basename} {
-    global pd_guidir
- 
-    set dirname $pd_guidir/$subdir
-
-    if {[regexp ".*.(txt|c)$" $basename]} {
-        menu_opentext $dirname/$basename
-    } elseif {[regexp ".*.html?$" $basename]} {
-                  menu_openhtml $dirname/$basename
-    } else {
-        pd [concat pd open [pdtk_enquote $basename] \
-                [pdtk_enquote $dirname] ;]
-    }
-}
-
-
-################## help browser and support functions #########################
-proc menu_doc_browser {dir} {
-        global .mbar
-        if {![file isdirectory $dir]} {
-                puts stderr "menu_doc_browser non-directory $dir\n"
-        }
-        if { [winfo exists .help_browser.frame] } {
-                raise .help_browser
-        } else {
-                toplevel .help_browser -menu .mbar
-                wm title .help_browser "Pd Documentation Browser"
-                frame .help_browser.frame
-                pack .help_browser.frame -side top -fill both
-                doc_make_listbox .help_browser.frame $dir 0
-         }
-    }
-
-proc doc_make_listbox {base dir count} {
-        # check for [file readable]?
-        #if { [info tclversion] >= 8.5 } {
-                # requires Tcl 8.5 but probably deals with special chars better
-#               destroy {expand}[lrange [winfo children $base] [expr {2 * $count}] end]
-        #} else {
-                if { [catch { eval destroy [lrange [winfo children $base] \
-                                                                                [expr { 2 * $count }] end] } \
-                                  errorMessage] } {
-                        puts stderr "doc_make_listbox: error listing $dir\n"
-                }
-        #}
-        # exportselection 0 looks good, but selection gets easily out-of-sync
-        set current_listbox [listbox "[set b "$base.listbox$count"]-list" -yscrollcommand \
-                                                         [list "$b-scroll" set] -height 20 -exportselection 0]
-        pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
-                -side left -expand 1 -fill y -anchor w
-        foreach item [concat [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] \
-                                          [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]]]  {
-                $current_listbox insert end "[file tail $item][expr {[file isdirectory $item] ? {/} : {}}]"
-        }
-        bind $current_listbox <Button-1> [list doc_navigate $dir $count %W %x %y]
-        bind $current_listbox <Double-Button-1> [list doc_double_button $dir $count %W %x %y]
-}
-
-proc doc_navigate {dir count width x y} {
-        if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
-                return
-        }
-        set dir_to_open [file join $dir $newdir]
-        if {[file isdirectory $dir_to_open]} {
-                doc_make_listbox [winfo parent $width] $dir_to_open [incr count]
-        }
-}
-
-proc doc_double_button {dir count width x y} {
-        global pd_guidir
-        if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
-                return
-        }
-        set dir_to_open [file join $dir $newdir]
-        if {[file isdirectory $dir_to_open]} {
-                 doc_navigate $dir $count $width $x $y
-        } else {
-                regsub -- $pd_guidir [file dirname $dir_to_open] "" subdir
-                set file [file tail $dir_to_open]
-                if { [catch {menu_doc_open $subdir $file} fid] } {
-                        puts stderr "Could not open $pd_guidir/$subdir/$file\n"
-                }
-                return; 
-        }
-}
-
-############# 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} 
-    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 command -label {Audio settings...} \
-        -command {pd pd audio-properties ;}
-    $mbar.audio add command -label {MIDI settings...} \
-        -command {pd pd midi-properties ;}
-         }
-         
-    $mbar.audio add command -label {Test Audio and MIDI} \
-        -command {menu_doc_open doc/7.stuff/tools testtone.pd} 
-    $mbar.audio add command -label {Load Meter} \
-        -command {menu_doc_open doc/7.stuff/tools load-meter.pd} 
-
-#       the 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/1.manual 1.introduction.txt} 
-                  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} \
+proc menu_create_help {rootmenu} {
+    if {[tk windowingsystem] ne "aqua"} {
+        $rootmenu add command -label {About Pd} \
             -command {menu_doc_open doc/1.manual 1.introduction.txt} 
     }
-    $mbar.help add command -label {Html ...} \
-        -command {menu_doc_open doc/1.manual index.htm} 
-    $mbar.help add command -label {Browser ...} \
+    $rootmenu add command -label {Html ...} \
+		-command {menu_doc_open doc/1.manual index.htm}
+    $rootmenu add command -label {Browser ...} \
         -command {menu_doc_browser $help_top_directory} 
 }
-#################### 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 Message -command {menu_send} \
-    -accelerator [accel_munge "Ctrl+m"]
-# On MacOS X, these are in the standard HIG locations
-# i.e. the Preferences menu under "Pd"
-if {$pd_nt != 2} {
-.mbar.file add command -label Path... \
-    -command {pd pd start-path-dialog ;}
-.mbar.file add command -label Startup... \
-    -command {pd pd start-startup-dialog ;}
+proc menu_create_apple {rootmenu} {
+	$rootmenu add command -label "About Pd..." -command \
+		{menu_doc_open doc/1.manual 1.introduction.txt} 
+	menu $rootmenu.preferences -tearoff 0
+	$rootmenu add cascade -label "Preferences" -menu $rootmenu.preferences
+	$rootmenu.preferences add command -label "Path..." \
+		-command {pd pd start-path-dialog ;}
+	$rootmenu.preferences add command -label "Startup..." \
+		-command {pd pd start-startup-dialog ;}
+	$rootmenu.preferences add command -label "Audio Settings..." \
+		-command {pd pd audio-properties ;}
+	$rootmenu.preferences add command -label "MIDI settings..." \
+		-command {pd pd midi-properties ;}
 }
-.mbar.file add  separator
-.mbar.file add command -label Quit -command {menu_quit} \
-    -accelerator [accel_munge "Ctrl+q"]
-#################### the "Find" menu for the Pd window ##############
-.mbar.find add command -label {Find last error} -command {menu_finderror} 
-
-###########  functions for menu functions on document windows ########
-
-proc menu_save {name} {
-    pdtk_canvas_checkgeometry $name
-    pd [concat $name menusave ;]
+proc menu_create {rootmenu} {
+	set menulist "file edit put media window help"
+	if { [tk windowingsystem] eq "aqua" } { 
+		set menulist "$menulist apple"
+	}
+	foreach menuitem $menulist {	
+		menu $rootmenu.$menuitem -tearoff 0
+		$rootmenu add cascade -label [string totitle $menuitem] \
+			-menu $rootmenu.$menuitem
+		[concat menu_create_$menuitem] $rootmenu.$menuitem
+		if {[tk windowingsystem] eq "win32"} {
+			$rootmenu.$menuitem configure -font menufont
+		}
+	}
 }
-proc menu_saveas {name} {
-    pdtk_canvas_checkgeometry $name
-    pd [concat $name menusaveas ;]
-}
-proc menu_print {name} {
-    set filename [tk_getSaveFile -initialfile pd.ps \
-       -defaultextension .ps \
-       -filetypes { {{postscript} {.ps}} }]
-
-    if {$filename != ""} {
-        $name.c postscript -file $filename 
-    }
+# ------------------------------------------------------------------------------
+# canvas support functions
+proc pdtk_canvas_new {canvas_name width height} {
+	if {$width < 200} {set width 200}
+	if {$height < 50} {set height 50}
+	toplevel $canvas_name -menu $canvas_name.menubar -width $width -height $height
+	menu $canvas_name.menubar -tearoff 0
+	menu_create $canvas_name.menubar
 }
-proc menu_close {name} {
-    pdtk_canvas_checkgeometry $name
-    pd [concat $name menuclose 0 ;]
-}
+# ------------------------------------------------------------------------------
+# main
+proc main {} {
-proc menu_really_close {name} {
-    pdtk_canvas_checkgeometry $name
-    pd [concat $name menuclose 1 ;]
-}
+menu .menubar
+menu_create .menubar
-proc menu_undo {name} {
-    global pd_undoaction
-    global pd_redoaction
-    global pd_undocanvas
-    if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
-        pd [concat $name undo ;]
-    }
-}
+wm title . "Pd-devel"
+#wm protocol . WM_DELETE_WINDOW menu_quit
+. configure -menu .menubar -width 400 -height 250
-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 ;]
-}
+main
-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
-    global pd_tearoff
-    $name.m.windows add command
-    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
-
-proc find_apply {name} {
-    global find_string
-    global find_canvas
-    regsub -all ; $find_string " _semi_ " find_string2
-    regsub -all , $find_string2 " _comma_ " find_string3
-#    puts stderr [concat $find_canvas find $find_string3 \
-#       ;]
-    pd [concat $find_canvas find $find_string3 \
-        ;]
-    after 50 destroy $name
-}
-
-proc find_cancel {name} {
-    after 50 destroy $name
-}
-
-proc menu_findobject {canvas} {
-    global find_string
-    global find_canvas
-    global find_count
-    
-    set name [format ".find%d" $find_count]
-    set find_count [expr $find_count + 1]
-
-    set find_canvas $canvas
-    
-    toplevel $name
-
-    label $name.label -text {find...}
-    pack $name.label -side top
-
-    entry $name.entry -textvariable find_string
-    pack $name.entry -side top
-
-    frame $name.buttonframe
-    pack $name.buttonframe -side bottom -fill x -pady 2m
-    button $name.buttonframe.cancel -text {Cancel}\
-        -command "find_cancel $name"
-    button $name.buttonframe.ok -text {OK}\
-        -command "find_apply $name"
-    pack $name.buttonframe.cancel -side left -expand 1
-    pack $name.buttonframe.ok -side left -expand 1
-    
-    $name.entry select from 0
-    $name.entry select adjust end
-    bind $name.entry <KeyPress-Return> [ concat find_apply $name]
-    pdtk_standardkeybindings $name.entry
-    focus $name.entry
-}
-
-
-############# pdtk_canvas_new -- create a new canvas ###############
-proc pdtk_canvas_new {name width height geometry editable} {
-    global pd_opendir
-    global pd_tearoff
-    global pd_nt
-    global tcl_version
-
-    toplevel $name -menu $name.m
-        # if we're a mac, refuse to make window so big you can't get to
-        # the resizing control
-    if {$pd_nt == 2} {
-        if {$width > [winfo screenwidth $name] - 80} {
-            set width [expr [winfo screenwidth $name] - 80]
-        }
-        if {$height > [winfo screenheight $name] - 80} {
-            set height [expr [winfo screenheight $name] - 80]
-        }
-    }
-    
-# 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
-        }
-        set geometry [join $geometry +] 
-   }
-   wm geometry $name $geometry
-   canvas $name.c -width $width -height $height -background white \
-        -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 1 1
-    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 Message -command {menu_send} \
-        -accelerator [accel_munge "Ctrl+m"]
-
-         # arrange menus according to Apple HIG
-         # these are now part of Preferences...
-         if {$pd_nt != 2 } {
-    $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 ;} 
-         }
-
-    $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 command -label Print -command [concat menu_print $name] \
-        -accelerator [accel_munge "Ctrl+p"]
-
-    $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 separator
-
-    $name.m.edit add command -label {Text Editor} \
-        -command [concat menu_texteditor $name] \
-        -accelerator [accel_munge "Ctrl+t"]
-
-    $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 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
-
-    $name.m.windows add command -label {parent window}\
-        -command [concat menu_windowparent $name] 
-    $name.m.windows add command -label {Pd window} -command menu_pop_pd
-    $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 <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_click %W %x %y %b 8}
-        bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
-    } else {
-        bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8}
-        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 <Key> {pdtk_canvas_key %W %K %A 0}
-    bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1}
-    bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
-    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
-    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 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_click {name x y b f} {
-    global pd_nt
-    if {$pd_nt == 0} {focus $name}
-    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f ;
-}
-
-proc pdtk_canvas_shiftclick {name x y b} {
-    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 ;
-}
-
-proc pdtk_canvas_ctrlclick {name x y b} {
-    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 ;
-}
-
-proc pdtk_canvas_altclick {name x y b} {
-    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 ;
-}
-
-proc pdtk_canvas_dblclick {name x y b} {
-    pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $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
-
-    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}
-        
-        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_key {name key iso shift} {
-#    puts stderr [concat down key= $key iso= $iso]
-#    .controls.switches.meterbutton configure -text $key
-#  HACK for MAC OSX -- backspace seems different; I don't understand why.
-#  invesigate this LATER...
-    global pd_nt
-    if {$pd_nt == 2} {
-        if {$key == "BackSpace"} {
-            set key 8
-            set keynum 8
-        }
-        if {$key == "Delete"} {
-            set key 8
-            set keynum 8
-        }
-    }
-    if {$key == "KP_Delete"} {
-        set key 127
-        set keynum 127
-    }
-    if {$iso != ""} {
-        scan $iso %c keynum 
-        pd [canvastosym $name] key 1 $keynum $shift;
-    } else {
-        pd [canvastosym $name] key 1 $key $shift;
-    }
-}
-
-proc pdtk_canvas_keyup {name key iso} {
-#    puts stderr [concat up key= $key iso= $iso]
-    if {$iso != ""} {
-        scan $iso %c keynum 
-        pd [canvastosym $name] key 0 $keynum 0 ;
-    } else {
-        pd [canvastosym $name] key 0 $key 0 ;
-    }
-}
-
-proc pdtk_canvas_ctrlkey {name key shift} {
-# 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 {$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}
-    } 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 == "n" || $key == "N"} {menu_new}
-        if {$key == "o" || $key == "O"} {menu_open}
-        if {$key == "m" || $key == "M"} {menu_send}
-        if {$key == "w" || $key == "W"} {menu_close $topname}
-        if {$key == "p" || $key == "P"} {menu_print $topname}
-        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 {$key == "t" || $key == "T"} {menu_texteditor $topname}
-        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
-    set filename [tk_getSaveFile -initialfile $initfile \
-       -initialdir $initdir  -defaultextension .pd \
-        -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }]
-
-    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 ;]
-    }
-}
-
-############ pdtk_canvas_dofont -- run a font and resize dialog #########
-
-set fontsize 0
-set stretchval 0
-set whichstretch 0
-
-proc dofont_apply {name} {
-    global fontsize
-    global stretchval
-    global whichstretch
-    set cmd [concat $name font $fontsize $stretchval $whichstretch ;]
-#    puts stderr $cmd
-    pd $cmd
-}
-
-proc dofont_cancel {name} {
-    set cmd [concat $name cancel ;]
-#    puts stderr $cmd
-    pd $cmd
-}
-
-proc pdtk_canvas_dofont {name initsize} {
-    
-    global fontsize
-    set fontsize $initsize
-    
-    global stretchval
-    set stretchval 100
-    
-    global whichstretch
-    set whichstretch 1
-    
-    toplevel $name
-    wm title $name  {FONT BOMB}
-    wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name]
-
-    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 {Do it}\
-        -command "dofont_apply $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 fontsize -text "8"
-    radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10"
-    radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12"
-    radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16"
-    radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24"
-    radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "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
-
-    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
-    wm title $id "atom box properties"
-    wm resizable $id 0 0
-    wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id]
-
-    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
-
-    bind $id.limits.upper.entry <KeyPress-Return> [concat dogatom_ok $id]
-    bind $id.limits.lower.entry <KeyPress-Return> [concat dogatom_ok $id]
-    bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id]
-    pdtk_standardkeybindings $id.limits.upper.entry
-    pdtk_standardkeybindings $id.limits.lower.entry
-    pdtk_standardkeybindings $id.params.entry
-    $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 {name xpix ypix canprop canopen} {
-    global popup_xpix popup_ypix
-    set popup_xpix $xpix
-    set popup_ypix $ypix
-    if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled}
-    if {$canprop == 1} {$name.popup entryconfigure 0 -state active}
-    if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled}
-    if {$canopen == 1} {$name.popup entryconfigure 1 -state active}
-    tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \
-         [expr $ypix + [winfo rooty $name.c]] 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]
-    
-    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
-    wm title $id [format "%s Properties" $mainheader]
-    wm resizable $id 0 0
-    wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id]
-    
-    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
@@ Diff output truncated at 100000 characters. @@
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.

    

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

[PD-cvs] SF.net SVN: pure-data:[10458] branches/pd-devel/0.41.4/src/pd.tk