[PD-cvs] SF.net SVN: pure-data:[10478] branches/pd-devel/0.41.4/src
eighthave at users.sourceforge.net
eighthave at users.sourceforge.net
Wed Jan 7 01:27:58 CET 2009
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.
More information about the Pd-cvs
mailing list