Revision: 10478 http://pure-data.svn.sourceforge.net/pure-data/?rev=10478&view=rev Author: eighthave Date: 2009-01-07 00:27:58 +0000 (Wed, 07 Jan 2009)
Log Message: ----------- - cleaned up formatting some
- switched from {} to "" quotes so that $name gets converted to its value before being bound to a key command.
- got menu_new and menu_close working, a window is created, then destroyed
- added "invalid command name" to the pd_connect catch
- added text to Pd window placeholder
Modified Paths: -------------- branches/pd-devel/0.41.4/src/pd.tk branches/pd-devel/0.41.4/src/pd_bindings.tcl branches/pd-devel/0.41.4/src/pd_connect.tcl branches/pd-devel/0.41.4/src/pd_menucommands.tcl branches/pd-devel/0.41.4/src/pd_menus.tcl
Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2009-01-06 19:36:42 UTC (rev 10477) +++ branches/pd-devel/0.41.4/src/pd.tk 2009-01-07 00:27:58 UTC (rev 10478) @@ -85,37 +85,73 @@ set oldtclversion 0 set fontlist "8 5 8 9 6 10 10 7 11 12 7 12 14 8 14 16 10 16 18 11 18 24 14 24 30 18 30 36 22 36" pd [concat pd init [pdtk_enquote [pwd]] $oldtclversion $fontlist ;]; + # TODO what else is needed from the original? }
proc pdtk_post {s} { + # TODO this should be switchable between Pd window and stderr puts stderr $s }
# ------------------------------------------------------------------------------ +# kludges to avoid changing C code + +proc .mbar.find {command number} { + # this should be changed in g_canvas.c, around line 800 + .menubar.find $command $number +} + +# ------------------------------------------------------------------------------ # canvas support functions -proc pdtk_canvas_new {canvas_name width height} { - if {$width < 300} {set width 300} - if {$height < 150} {set height 150} - toplevel $canvas_name -width $width -height $height - ::pd_menus::create_menubar $canvas_name.menubar - $canvas_name configure -menu $canvas_name.menubar - ::pd_bindings::canvas_bindings $canvas_name + +##### 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} }
+proc pdtk_fixwindowmenu {} { + #TODO figure out how to do this cleanly + puts stderr "Running pdtk_fixwindowmenu" +} + +proc pdtk_canvas_new {name width height geometry editable} { + # TODO check size of window + toplevel $name -width $width -height $height + ::pd_menus::create_menubar $name.menubar + $name configure -menu $name.menubar + ::pd_bindings::canvas_bindings $name + + # TODO slide off screen windows into view + wm geometry $name $geometry + canvas $name.c -width $width -height $height -background white + + # the popup menu for the canvas + menu $name.popup -tearoff false + $name.popup add command -label "Properties" -command {popup_action $name 0} + $name.popup add command -label "Open" -command {popup_action $name 1} + $name.popup add command -label "Help" -command {popup_action $name 2} + +} + # ------------------------------------------------------------------------------ # main proc main {argc argv} { pdtk_post "Starting pd.tk with main($argc $argv)" init
- wm title . "Pd-devel" - ::pd_menus::create_menubar .menubar . configure -menu .menubar -width 400 -height 250 ::pd_menus::configure_pdwindow .menubar ::pd_bindings::window_bindings .
+ wm title . "Pd-devel" + frame .placeholder + label .placeholder.label -text "Pd window placeholder" -width 80 -height 15 + pack .placeholder.label .placeholder -side top -expand yes -fill both + ::pd_connect::connect_to_pd [lindex $argv 0] }
Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-06 19:36:42 UTC (rev 10477) +++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-07 00:27:58 UTC (rev 10478) @@ -19,19 +19,19 @@ variable modifier
# File menu - bind $name <$modifier-Key-b> {menu_helpbrowser} - bind $name <$modifier-Key-n> {menu_new} - bind $name <$modifier-Key-o> {menu_open} - bind $name <$modifier-Key-p> {menu_print $name} - bind $name <$modifier-Key-q> {menu_quit} - bind $name <$modifier-Key-r> {menu_raiseconsole} - bind $name <$modifier-Key-w> {menu_close $name} - bind $name <$modifier-Shift-Key-L> {menu_clear_console} - bind $name <$modifier-Shift-Key-R> {menu_toggle_console} + bind $name <$modifier-Key-b> "menu_helpbrowser" + bind $name <$modifier-Key-n> "menu_new" + bind $name <$modifier-Key-o> "menu_open" + bind $name <$modifier-Key-p> "menu_print $name" + bind $name <$modifier-Key-q> "menu_quit" + bind $name <$modifier-Key-r> "menu_raiseconsole" + bind $name <$modifier-Key-w> "menu_close $name" + bind $name <$modifier-Shift-Key-L> "menu_clear_console" + bind $name <$modifier-Shift-Key-R> "menu_toggle_console"
# DSP control - bind $name <$modifier-Key-slash> {menu_audio 1} - bind $name <$modifier-Key-period> {menu_audio 0} + bind $name <$modifier-Key-slash> "menu_audio 1" + bind $name <$modifier-Key-period> "menu_audio 0" }
proc ::pd_bindings::pdwindow_bindings {name} { @@ -39,14 +39,14 @@
window_bindings $name
- bind . <$modifier-Key-a> {.printout.text tag add sel 1.0 end} - bind . <$modifier-Key-x> {tk_textCut .printout.text} - bind . <$modifier-Key-c> {tk_textCopy .printout.text} - bind . <$modifier-Key-v> {tk_textPaste .printout.text} + bind . <$modifier-Key-a> ".printout.text tag add sel 1.0 end" + bind . <$modifier-Key-x> "tk_textCut .printout.text" + bind . <$modifier-Key-c> "tk_textCopy .printout.text" + bind . <$modifier-Key-v> "tk_textPaste .printout.text" bind . <$modifier-Key-w> {pdtk_post "Can't close Pd window, ignored.\n"}
- # event bindings - wm protocol . WM_DELETE_WINDOW menu_quit + # Tcl event bindings + wm protocol . WM_DELETE_WINDOW "menu_quit" }
proc ::pd_bindings::panel_bindings {name} { @@ -64,44 +64,46 @@
window_bindings $name
- bind $name <$modifier-Key-1> {menu_object $name 1} - bind $name <$modifier-Key-2> {menu_message $name 1} - bind $name <$modifier-Key-3> {menu_floatatom $name 1} - bind $name <$modifier-Key-4> {menu_symbolatom $name 1} - bind $name <$modifier-Key-5> {menu_comment $name 1} - bind $name <$modifier-Key-a> {menu_selectall $name} - bind $name <$modifier-Key-c> {menu_copy $name} - bind $name <$modifier-Key-d> {menu_duplicate $name} - bind $name <$modifier-Key-e> {menu_editmode $name} - bind $name <$modifier-Key-f> {menu_findobject $name} - bind $name <$modifier-Key-g> {menu_findagain $name} - bind $name <$modifier-Key-s> {menu_save $name} - bind $name <$modifier-Key-v> {menu_paste $name} - bind $name <$modifier-Key-x> {menu_cut $name} - bind $name <$modifier-Key-z> {menu_undo $name} + bind $name <$modifier-Key-1> "menu_object $name 1" + bind $name <$modifier-Key-2> "menu_message $name 1" + bind $name <$modifier-Key-3> "menu_floatatom $name 1" + bind $name <$modifier-Key-4> "menu_symbolatom $name 1" + bind $name <$modifier-Key-5> "menu_comment $name 1" + bind $name <$modifier-Key-a> "menu_selectall $name" + bind $name <$modifier-Key-c> "menu_copy $name" + bind $name <$modifier-Key-d> "menu_duplicate $name" + bind $name <$modifier-Key-e> "menu_editmode $name" + bind $name <$modifier-Key-f> "menu_findobject $name" + bind $name <$modifier-Key-g> "menu_findagain $name" + bind $name <$modifier-Key-s> "menu_save $name" + bind $name <$modifier-Key-v> "menu_paste $name" + bind $name <$modifier-Key-x> "menu_cut $name" + bind $name <$modifier-Key-z> "menu_undo $name"
# annoying, but Tk's bind needs uppercase letter to get the Shift - bind $name <$modifier-Shift-Key-B> {menu_bang} - bind $name <$modifier-Shift-Key-C> {menu_canvas} - bind $name <$modifier-Shift-Key-D> {menu_vradio} - bind $name <$modifier-Shift-Key-H> {menu_hslider} - bind $name <$modifier-Shift-Key-I> {menu_hradio} - bind $name <$modifier-Shift-Key-N> {menu_number2} - bind $name <$modifier-Shift-Key-S> {menu_saveas $name} - bind $name <$modifier-Shift-Key-T> {menu_toggle} - bind $name <$modifier-Shift-Key-U> {menu_vumeter} - bind $name <$modifier-Shift-Key-V> {menu_vslider} - bind $name <$modifier-Shift-Key-Z> {menu_redo $name} + bind $name <$modifier-Shift-Key-B> "menu_bang" + bind $name <$modifier-Shift-Key-C> "menu_canvas" + bind $name <$modifier-Shift-Key-D> "menu_vradio" + bind $name <$modifier-Shift-Key-H> "menu_hslider" + bind $name <$modifier-Shift-Key-I> "menu_hradio" + bind $name <$modifier-Shift-Key-N> "menu_number2" + bind $name <$modifier-Shift-Key-S> "menu_saveas $name" + bind $name <$modifier-Shift-Key-T> "menu_toggle" + bind $name <$modifier-Shift-Key-U> "menu_vumeter" + bind $name <$modifier-Shift-Key-V> "menu_vslider" + bind $name <$modifier-Shift-Key-Z> "menu_redo $name"
if {[tk windowingsystem] eq "aqua"} { - bind $name <Mod1-Key-m> {menu_minimize $name} - bind $name <Mod1-Key-t> {menu_font $name} + bind $name <Mod1-Key-m> "menu_minimize $name" + bind $name <Mod1-Key-t> "menu_font $name" } else { - bind $name <Control-Key-m> {menu_send $name} - bind $name <Control-Key-t> {menu_texteditor $name} + bind $name <Control-Key-m> "menu_send $name" + bind $name <Control-Key-t> "menu_texteditor $name" }
- # event bindings - wm protocol $name WM_DELETE_WINDOW {menu_close $name} + # Tcl event bindings + wm protocol $name WM_DELETE_WINDOW "menu_close $name" + + # TODO add mouse button bindings }
Modified: branches/pd-devel/0.41.4/src/pd_connect.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-06 19:36:42 UTC (rev 10477) +++ branches/pd-devel/0.41.4/src/pd_connect.tcl 2009-01-07 00:27:58 UTC (rev 10478) @@ -18,7 +18,7 @@ } puts stderr "Connected to pd on port $portnumber" fconfigure $pd_socket -blocking 1 -buffering line - fileevent $pd_socket readable [list ::pd_connect::pd_readsocket ""] + fileevent $pd_socket readable {::pd_connect::pd_readsocket ""} }
# send a message from Tcl to Pd @@ -32,19 +32,22 @@ # global so that eval runs in the global namespace proc ::pd_connect::pd_readsocket {cmd_from_pd} { variable pd_socket - if {$cmd_from_pd == ""} {puts stderr "called with blank args aka READABLE"} +# if {$cmd_from_pd == ""} {puts stderr "called with blank args aka READABLE"} append cmd_from_pd [gets $pd_socket] puts stderr "cmd_from_pd: $cmd_from_pd" - if {[catch {uplevel #0 $cmd_from_pd}]} { + if {[catch {uplevel #0 $cmd_from_pd} error]} { global errorInfo - puts stderr "errorInfo <<$errorInfo>>" - if {[regexp -line -- "^missing close-brace.*" $errorInfo]} { - # TODO consider using [info complete $cmd_from_pd] in a loop - puts stderr "appending another line" - pd_readsocket $cmd_from_pd - } else { - #puts stderr "DIFFERENT ERROR on eval: $errorInfo" - puts stderr "DIFFERENT ERROR on eval" +# puts stderr "errorInfo <<$errorInfo>>" + switch -regexp -- $errorInfo { + "^missing close-brace" { + # TODO consider using [info complete $cmd_from_pd] in a loop + puts stderr "appending another line" + pd_readsocket $cmd_from_pd + } "^invalid command name" { + puts stderr "INVALID COMMAND: $errorInfo" + } default { + puts stderr "DIFFERENT ERROR on eval: $errorInfo" + } } } }
Modified: branches/pd-devel/0.41.4/src/pd_menucommands.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-06 19:36:42 UTC (rev 10477) +++ branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-07 00:27:58 UTC (rev 10478) @@ -5,6 +5,9 @@ # PLACEHOLDERS
namespace eval ::pd_menucommands:: { + variable untitled_number "1" + variable untitled_directory [pwd] + namespace export menu_* }
@@ -16,19 +19,6 @@ # PLACEHOLDER }
-proc ::pd_menucommands::menu_new {} { - # PLACEHOLDER - pdtk_canvas_new [format .flarg%d [expr round(rand()*1000)]] 30 10 -} - -proc ::pd_menucommands::menu_open {} { - global pd_opendir - set filename [tk_getOpenFile -defaultextension .pd \ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ - -initialdir [pwd]] - if {$filename != ""} {open_file $filename} -} - proc ::pd_menucommands::menu_quit {} { # PLACEHOLDER exit @@ -51,9 +41,35 @@
# ------------------------------------------------------------------------------ -# functions called from menu items +# functions called from File menu
+proc ::pd_menucommands::menu_new {} { + variable untitled_number + variable untitled_directory + pd [concat pd filename Untitled-$untitled_number $untitled_directory ;] + pd { + #N canvas; + #X pop 1; + } + set untitled_number [expr $untitled_number + 1] +}
+proc ::pd_menucommands::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 ::pd_menucommands::menu_close {name} { + pd [concat $name menuclose 0 ;] +} + +# ------------------------------------------------------------------------------ +# window management functions + + proc ::pd_menucommands::menu_minimize {} { set windowlist [wm stackorder .] if {$windowlist != {}} {
Modified: branches/pd-devel/0.41.4/src/pd_menus.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-06 19:36:42 UTC (rev 10477) +++ branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-07 00:27:58 UTC (rev 10478) @@ -37,12 +37,12 @@
proc ::pd_menus::create_file_menu_aqua {rootmenu} { variable accelerator - $rootmenu add command -label [say "new_file"] -accelerator "$accelerator+N" - $rootmenu add command -label [say "Open"] -accelerator "$accelerator+O" + $rootmenu add command -label [say "new_file"] -accelerator "$accelerator+N" + $rootmenu add command -label [say "Open"] -accelerator "$accelerator+O" $rootmenu add cascade -label [say "Open Recent"] $rootmenu add separator - $rootmenu add command -label [say "Close"] -accelerator "$accelerator+W" - $rootmenu add command -label [say "Save"] -accelerator "$accelerator+S" + $rootmenu add command -label [say "Close"] -accelerator "$accelerator+W" + $rootmenu add command -label [say "Save"] -accelerator "$accelerator+S" $rootmenu add command -label [say "Save As..."] -accelerator "$accelerator+Shift+S" # $rootmenu add command -label [say "Save All"] $rootmenu add command -label [say "Revert to Saved"] @@ -132,7 +132,7 @@ $rootmenu entryconfigure [say "Save"] -command {menu_save $name} $rootmenu entryconfigure [say "Save As..."] -command {menu_saveas $name} # $rootmenu entryconfigure "Revert*" -command {menu_revert $name} - $rootmenu entryconfigure [say "Close"] -command {menu_close $name} + $rootmenu entryconfigure [say "Close"] -command [concat menu_close $name] $rootmenu entryconfigure [say "Message"] -command {menu_send} $rootmenu entryconfigure [say "Print..."] -command {menu_print $name} }
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.