From 388f7a1df37afeed0dd120f8091614a7f6dd91ab Mon Sep 17 00:00:00 2001
From: Miller Puckette <millerpuckette@users.sourceforge.net>
Date: Wed, 18 May 2005 04:28:51 +0000
Subject: Damn, edited this before and lost the update.  More data features.
 Took about 12 patches.

svn path=/trunk/; revision=3006
---
 pd/src/u_main.tk | 806 ++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 507 insertions(+), 299 deletions(-)

(limited to 'pd/src/u_main.tk')

diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk
index dcb1e31b..7e11b5f3 100644
--- a/pd/src/u_main.tk
+++ b/pd/src/u_main.tk
@@ -50,6 +50,18 @@ if {$pd_nt == 2} {
     set pd_guidir $pd_gui2/..
     load $pd_guidir/bin/pdtcl
     set pd_tearoff 0
+
+	 # 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} {
+		  foreach file $args {
+				pd [concat pd open [pdtk_enquote [file tail $file]] \
+						  [pdtk_enquote  [file dirname $file]] \;]
+				menu_doc_open [file dirname $file] [file tail $file]
+		  }
+	 }
 }
 
 # hack so you can easily test-run this script in linux... define pd_guidir
@@ -74,6 +86,8 @@ 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
 
@@ -88,13 +102,25 @@ 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
+# a menu on the main menubar named $whatever.help while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+	 menu .mbar.help -tearoff $pd_tearoff
+	 .mbar add cascade -label "Help" -menu .mbar.help
 } else {
-# Perhaps this is silly, but Mac HIG want "Window  Help" as the last menus
+	 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 "Windows" -menu .mbar.windows
+    .mbar add cascade -label "Window" -menu .mbar.windows
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+# Apple doesn't allow cascading menus in their Help so I had to call this 
+# one $mbar.docs # <hans@at.or.at>
+	 menu .mbar.docs -tearoff $pd_tearoff
+	 .mbar add cascade -label "Help" -menu .mbar.docs
 }
-menu .mbar.help -tearoff $pd_tearoff
-.mbar add cascade -label "Help" -menu .mbar.help
 
 set ctrls_audio_on 0
 set ctrls_meter_on 0
@@ -263,22 +289,26 @@ proc menu_new {} {
 
 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}
+}
 
-    if {$filename != ""} {
-    	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]
-
-#    	 pd_debug [concat file $filename base $basename dir $directory]
+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] ;"
+    }
+}
 
-    	pd [concat pd open [pdtk_enquote $basename] \
-		[pdtk_enquote $directory]\;]
+catch {
+    package require tkdnd
+    dnd bindtarget . text/uri-list <Drop> {
+	foreach file %D {open_file $file}
     }
 }
 
@@ -311,13 +341,15 @@ proc menu_audio {flag} {pd [concat pd dsp $flag \;]}
 
 set doc_number 1
 
+# open text docs in a Pd window
 proc menu_opentext {filename} {
     global doc_number
     global pd_guidir
     global pd_myversion
+	global pd_font3
     set name [format ".help%d" $doc_number]
     toplevel $name
-    text $name.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \
+    text $name.text -relief raised -bd 2 -font $pd_font3 \
     	-yscrollcommand "$name.scroll set" -background white
     scrollbar $name.scroll -command "$name.text yview"
     pack $name.scroll -side right -fill y
@@ -334,15 +366,34 @@ proc menu_opentext {filename} {
     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} {
+        exec sh -c \
+            [format "firefox file:%s || mozilla file:%s &\n" \
+                $filename $filename]
+    } 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] &
+    }
+}
+
 set help_directory $pd_guidir/doc
+set help_top_directory $pd_guidir/doc
 
 proc menu_documentation {} {
     global help_directory
     global pd_nt
+    global pd_guidir
 
     if {$pd_nt == 2} {
     	exec rm -rf /tmp/pd-documentation
-    	exec cp -pr $help_directory /tmp/pd-documentation
+    	exec cp -pr $pd_guidir/doc /tmp/pd-documentation
 	set filename [tk_getOpenFile -defaultextension .pd \
 	-filetypes { {{documentation} {.pd .txt .htm}} } \
 	-initialdir /tmp/pd-documentation]
@@ -355,18 +406,7 @@ proc menu_documentation {} {
     	if {[string first .txt $filename] >= 0} {
     	    menu_opentext $filename
     	} elseif {[string first .htm $filename] >= 0} {
-	    if {$pd_nt == 0} {
-	    	exec sh -c \
-		    [format "mozilla file:%s || netscape file:%s &\n" \
-		    	 $filename $filename]
-            } 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] &
-    	    }
+				menu_openhtml $filename
 	} else {
 	    set help_directory [string range $filename 0 \
     		[expr [string last / $filename ] - 1]]
@@ -383,18 +423,43 @@ proc menu_doc_open {subdir basename} {
  
     set dirname $pd_guidir/$subdir
 
-    if {[string first .txt $basename] >= 0} {
+    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] \;]
     }
 }
 
-############# routine to add audio and help menus ###############
+proc doc_submenu {helpmenu subdir} {
+	 global help_top_directory pd_tearoff
+
+	 set menudir $help_top_directory/$subdir
+
+    regsub -all "\\\." $subdir "" submenu
+
+	 menu $helpmenu.$submenu -tearoff $pd_tearoff
+    regsub -all "\\\." $subdir " " submenuname
+	 $helpmenu add cascade -label $submenuname \
+		  -menu $helpmenu.$submenu
+    catch {
+# use this glob pattern to exclude the supporting files
+#	 foreach file [ lsort [ glob -dir $menudir {*[0-9][0-9]*} ] ] 
+	 foreach file [ lsort [ glob -dir $menudir * ] ] {
+		  set filename ""
+		  regsub {.*/(.*\..+$)} $file {\1} filename
+		  $helpmenu.$submenu add command -label $filename \
+				-command "menu_doc_open doc/$subdir $filename"
+	 }
+    }
+}
+
+############# routine to add media, help, and apple menu items ###############
 
 proc menu_addstd {mbar} {
-    global pd_apilist
+    global pd_apilist pd_nt pd_tearoff
 #          the "Audio" menu
     $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \
 	-command {menu_audio 1} 
@@ -406,21 +471,66 @@ proc menu_addstd {mbar} {
 	    	-value [lindex [lindex $pd_apilist $x] 1]\
 		-command {pd [concat pd audio-setapi $pd_whichapi \;]}
     }
+	 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} {
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
     $mbar.help add command -label {About Pd} \
 	-command {menu_doc_open doc/1.manual 1.introduction.txt} 
     $mbar.help add command -label {Pure Documentation...} \
 	-command {menu_documentation} 
+		  # add menu items for each section instead of using Pd patches
+		  $mbar.help add separator
+		  set helpmenuname help
+	 } else {
+# Apple doesn't allow cascading menus in their Help so I had to call this 
+# one "docs"  <hans@at.or.at>
+		  set helpmenuname docs
+	 }
+
+	 $mbar.$helpmenuname add command -label {1 manual...} \
+		  -command {menu_doc_open doc/1.manual index.htm} 
+	 doc_submenu $mbar.$helpmenuname 2.control.examples
+	 doc_submenu $mbar.$helpmenuname 3.audio.examples
+	 doc_submenu $mbar.$helpmenuname 4.fft.examples
+	 doc_submenu $mbar.$helpmenuname 5.reference
+	 doc_submenu $mbar.$helpmenuname 6.externs
 }
 
 #################### the "File" menu for the Pd window ##############
@@ -432,16 +542,20 @@ proc menu_addstd {mbar} {
 .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 \;}
+}
 .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 {last error?} -command {menu_finderror} 
+.mbar.find add command -label {Find last error} -command {menu_finderror} 
 
 ###########  functions for menu functions on document windows ########
 
@@ -466,6 +580,7 @@ proc menu_print {name} {
 }
 
 proc menu_close {name} {
+    pdtk_canvas_checkgeometry $name
     pd [concat $name menuclose \;]
 }
 
@@ -721,8 +836,22 @@ proc pdtk_canvas_new {name width height geometry editable} {
     global pd_nt
 
     toplevel $name -menu $name.m
-#    puts stderr [concat geometry: $geometry]
-    wm geometry $name $geometry
+
+# slide offscreen windows into view
+    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" \
@@ -739,6 +868,9 @@ proc pdtk_canvas_new {name width height geometry editable} {
     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
@@ -753,11 +885,15 @@ proc pdtk_canvas_new {name width height geometry editable} {
     $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 \
@@ -823,6 +959,18 @@ proc pdtk_canvas_new {name width height geometry editable} {
 
     $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.
@@ -834,9 +982,242 @@ proc pdtk_canvas_new {name width height geometry editable} {
 
     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
+
+# a menu on the main menubar named "$whatever.help" while be treated
+# as a special menu with specific behaviors on different platforms.
+# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
+	 if {$pd_nt != 2} {
+    menu $name.m.help -tearoff $pd_tearoff
+    $name.m add cascade -label Help -menu $name.m.help
+	 } else {
+		  # Apple doesn't allow cascading menus in their Help
+		  # so I had to call this one "docs". <hans@at.or.at>
+		  menu $name.m.docs -tearoff $pd_tearoff
+		  $name.m add cascade -label Help -menu  $name.m.docs
+	 }
+
+    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] 
+
+# 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 <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
@@ -1041,203 +1422,6 @@ proc pdtk_array_listview_close {id arrayName} {
 }
 ##### end jsarlo #####
 
-# 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 "Alt+b"]
-    
-    $name.m.put add command -label Toggle \
-    	-command [concat menu_toggle $name 0] \
-	-accelerator [accel_munge "Alt+t"]
-    
-    $name.m.put add command -label Number2 \
-    	-command [concat menu_numbox $name 0] \
-	-accelerator [accel_munge "Alt+n"]
-    
-    $name.m.put add command -label Vslider \
-    	-command [concat menu_vslider $name 0] \
-	-accelerator [accel_munge "Alt+v"]
-    
-    $name.m.put add command -label Hslider \
-    	-command [concat menu_hslider $name 0] \
-	-accelerator [accel_munge "Alt+h"]
-    
-    $name.m.put add command -label Vradio \
-    	-command [concat menu_vradio $name 0] \
-	-accelerator [accel_munge "Alt+d"]
-    
-    $name.m.put add command -label Hradio \
-    	-command [concat menu_hradio $name 0] \
-	-accelerator [accel_munge "Alt+i"]
-    
-    $name.m.put add command -label VU \
-    	-command [concat menu_vumeter $name 0] \
-	-accelerator [accel_munge "Alt+u"]
-    
-    $name.m.put add command -label Canvas \
-    	-command [concat menu_mycnv $name 0] \
-	-accelerator [accel_munge "Alt+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
-    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 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] 
-
-# 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 <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}
-    if {$pd_nt == 2} {
-    	bind $name.c <Option-Key> {pdtk_canvas_altkey %W %K %A}
-    } else {
-    	bind $name.c <Alt-Key> {pdtk_canvas_altkey %W %K %A}
-    }
-#    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
-#    puts stderr "all done"
-#   after 1 [concat raise $name]
-}
-
 #################### event binding procedures ################
 
 #get the name of the toplevel window for a canvas; this is also
@@ -1376,49 +1560,11 @@ proc pdtk_canvas_keyup {name key iso} {
     }
 }
 
-proc pdtk_canvas_altkey {name key iso} {
-#   puts stderr [concat alt-key $iso]
-############iemlib##################
-    set topname [string trimright $name .c]
-    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}
-############iemlib##################
-}
-
 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 == "n" || $key == "N"} {menu_new}
-    if {$key == "o" || $key == "O"} {menu_open}
-    if {$key == "m" || $key == "M"} {menu_send}
-    if {$key == "q" || $key == "Q"}  {
-     	if {$shift == 1} {menu_really_quit} else {menu_quit}
-    }
-    if {$key == "s" || $key == "S"} {
-      	if {$shift == 1} {menu_saveas $topname} else {menu_save $topname}
-    }
-    if {$key == "z" || $key == "Z"} {
-      	if {$shift == 1} {menu_redo $topname} else {menu_undo $topname}
-    }
-    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}
     if {$key == "1"} {menu_object $topname 1}
     if {$key == "2"} {menu_message $topname 1}
     if {$key == "3"} {menu_floatatom $topname 1}
@@ -1426,7 +1572,42 @@ proc pdtk_canvas_ctrlkey {name key shift} {
     if {$key == "5"} {menu_comment $topname 1}
     if {$key == "slash"} {menu_audio 1}
     if {$key == "period"} {menu_audio 0}
-    if {$key == "e" || $key == "E"} {menu_editmode $topname}
+    if {$shift == 1} {
+        if {$key == "q" || $key == "Q"} {menu_really_quit}
+        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} {
@@ -1447,6 +1628,16 @@ proc pdtk_canvas_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 ##############
@@ -2908,7 +3099,7 @@ proc dodata_ok {name} {
 }
 
 proc pdtk_data_dialog {name stuff} {
-    
+    global pd_font3
     toplevel $name
     wm title $name {Atom}
     wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name]
@@ -2923,7 +3114,7 @@ proc pdtk_data_dialog {name stuff} {
     pack $name.buttonframe.ok -side left -expand 1
 
     text $name.text -relief raised -bd 2 -height 40 -width 60 \
-    	-yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-*
+    	-yscrollcommand "$name.scroll set" -font pd_font3
     scrollbar $name.scroll -command "$name.text yview"
     pack $name.scroll -side right -fill y
     pack $name.text -side left -fill both -expand 1
@@ -2948,8 +3139,20 @@ proc pdtk_canvas_editval {name value} {
 proc pdtk_text_new {canvasname myname x y text font color} {
 #    if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]}
 #    if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]}
+
+	global pd_font1 pd_font2 pd_font3 pd_font4 pd_font5 pd_font6 pd_font7 
+	switch -- $font {
+		8  { set typeface $pd_font1 }
+		10 { set typeface $pd_font2 }
+		12 { set typeface $pd_font3 }
+		14 { set typeface $pd_font4 }
+		16 { set typeface $pd_font5 }
+		24 { set typeface $pd_font6 }
+		36 { set typeface $pd_font7 }
+	}
+
     $canvasname create text $x $y \
-    	-font [format -*-courier-bold--normal--%d-* $font] \
+    	-font $typeface \
     	-tags $myname -text $text -fill $color  -anchor nw 
 #    pd [concat $myname size [$canvasname bbox $myname] \;]
 }
@@ -2980,31 +3183,36 @@ proc pdtk_pd_ctrlkey {name key shift} {
 # asked pd to open something.  Also, get character width and height for
 # font sizes 8, 10, 12, 14, 16, and 24.
 
-proc pdtk_pd_startup {version apilist} {
+# tb: user defined typefaces
+proc pdtk_pd_startup {version apilist fontname} {
+#    puts stderr [concat $version $apilist $fontname]
     global pd_myversion pd_apilist
     set pd_myversion $version
     set pd_apilist $apilist
-
-    set width1 [font measure  -*-courier-bold--normal--8-* x]
-    set height1 [lindex [font metrics -*-courier-bold--normal--8-*] 5]
-
-    set width2 [font measure  -*-courier-bold--normal--10-* x]
-    set height2 [lindex [font metrics -*-courier-bold--normal--10-*] 5]
-
-    set width3 [font measure  -*-courier-bold--normal--12-* x]
-    set height3 [lindex [font metrics -*-courier-bold--normal--12-*] 5]
-
-    set width4 [font measure  -*-courier-bold--normal--14-* x]
-    set height4 [lindex [font metrics -*-courier-bold--normal--14-*] 5]
-
-    set width5 [font measure  -*-courier-bold--normal--16-* x]
-    set height5 [lindex [font metrics -*-courier-bold--normal--16-*] 5]
-
-    set width6 [font measure  -*-courier-bold--normal--24-* x]
-    set height6 [lindex [font metrics -*-courier-bold--normal--24-*] 5]
-
-    set width7 [font measure  -*-courier-bold--normal--36-* x]
-    set height7 [lindex [font metrics -*-courier-bold--normal--36-*] 5]
+	global pd_font1 pd_font2 pd_font3 pd_font4 pd_font5 pd_font6 pd_font7
+
+	set pd_font1 [format -*-%s-bold--normal--8-* $fontname]
+	set pd_font2 [format -*-%s-bold--normal--10-* $fontname]
+ 	set pd_font3 [format -*-%s-bold--normal--12-* $fontname]
+ 	set pd_font4 [format -*-%s-bold--normal--14-* $fontname]
+	set pd_font5 [format -*-%s-bold--normal--16-* $fontname]
+	set pd_font6 [format -*-%s-bold--normal--24-* $fontname]
+	set pd_font7 [format -*-%s-bold--normal--36-* $fontname]
+
+    set width1 [font measure  $pd_font1 x]
+    set height1 [lindex [font metrics $pd_font1] 5]
+    set width2 [font measure  $pd_font2 x]
+    set height2 [lindex [font metrics $pd_font2] 5]
+    set width3 [font measure  $pd_font3 x]
+    set height3 [lindex [font metrics $pd_font3] 5]
+    set width4 [font measure  $pd_font4 x]
+    set height4 [lindex [font metrics $pd_font4] 5]
+    set width5 [font measure  $pd_font5 x]
+    set height5 [lindex [font metrics $pd_font5] 5]
+    set width6 [font measure  $pd_font6 x]
+    set height6 [lindex [font metrics $pd_font6] 5]
+    set width7 [font measure  $pd_font7 x]
+    set height7 [lindex [font metrics $pd_font7] 5]
 
     set tclpatch [info patchlevel]
     if {$tclpatch == "8.3.0" || \
@@ -3088,7 +3296,7 @@ proc texteditor_ok {name} {
 
 
 proc pdtk_pd_texteditor {stuff} {
-    global edit_number
+    global edit_number pd_font3
     set name [format ".text%d" $edit_number]
     set edit_number [expr $edit_number + 1]
 
@@ -3105,7 +3313,7 @@ proc pdtk_pd_texteditor {stuff} {
     pack $name.buttons.ok -side left -expand 1
 
     text $name.text -relief raised -bd 2 -height 12 -width 60 \
-    	-yscrollcommand "$name.scroll set" -font -*-courier-bold--normal--12-*
+    	-yscrollcommand "$name.scroll set" -font $pd_font3
     scrollbar $name.scroll -command "$name.text yview"
     pack $name.scroll -side right -fill y
     pack $name.text -side left -fill both -expand 1
-- 
cgit v1.2.1