Revision: 10492 http://pure-data.svn.sourceforge.net/pure-data/?rev=10492&view=rev Author: eighthave Date: 2009-01-09 05:10:16 +0000 (Fri, 09 Jan 2009)
Log Message: ----------- - sketched out some platform-specific functions, like the Windows 'system' menu and the ::tk::mac stuff
- attempted to get the preferences menu to show up in the .apple menu, but no luck. I think this only works on Tcl/Tk 8.4.14 or later.
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_menucommands.tcl branches/pd-devel/0.41.4/src/pd_menus.tcl branches/pd-devel/0.41.4/src/pkgIndex.tcl branches/pd-devel/0.41.4/src/pkg_mkIndex.tcl branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl
Added Paths: ----------- branches/pd-devel/0.41.4/src/AppMain.tcl branches/pd-devel/0.41.4/src/apple_events.tcl
Added: branches/pd-devel/0.41.4/src/AppMain.tcl =================================================================== --- branches/pd-devel/0.41.4/src/AppMain.tcl (rev 0) +++ branches/pd-devel/0.41.4/src/AppMain.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -0,0 +1,8 @@ + +# this file is for the Wish.app on Mac OS X + +if {[string first "-psn" [lindex $argv 0]] == 0} { set argv [lrange $argv 1 end]} + +console show + +# launch pd.tk here
Added: branches/pd-devel/0.41.4/src/apple_events.tcl =================================================================== --- branches/pd-devel/0.41.4/src/apple_events.tcl (rev 0) +++ branches/pd-devel/0.41.4/src/apple_events.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -0,0 +1,36 @@ + +package provide apple_events 0.1 + +# from http://wiki.tcl.tk/12987 + +# minimum line thickness to anti-alias (default: 3) +set tk::mac::CGAntialiasLimit 2 + +# enable/disable anti-aliased text +set ::tk::mac::antialiasedtext 1 + +# kAEOpenDocuments +proc ::tk::mac::OpenDocument {} { +} + +# kEventAppHidden +proc ::tk::mac::OnHide {} { +} + +# kEventAppShown +proc ::tk::mac::OnShow {} { +} + +#kAEShowPreferences +proc ::tk::mac::ShowPreferences {} { +} + +#kAEQuitApplication +#proc exit {} { +# this proc overrides the built-in exit +#} + +proc spinCursor {widget count} { + $widget configure -cursor spinning$count + after 100 spinCursor [incr count] +}
Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pd.tk 2009-01-09 05:10:16 UTC (rev 10492) @@ -11,6 +11,7 @@ #namespace import -force ttk::*
# set . as first dir in auto_path +set auto_path [linsert $auto_path 0 "/Users/hans/code/pure-data/branches/pd-devel/0.41.4/src"] set auto_path [linsert $auto_path 0 "."]
package require pd_connect @@ -93,14 +94,6 @@ }
# ------------------------------------------------------------------------------ -# 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
##### routine to ask user if OK and, if so, send a message on to Pd ###### @@ -137,6 +130,10 @@ # ------------------------------------------------------------------------------ # main proc main {argc argv} { + # Not all platforms have the console command + catch {console show} + post_tclinfo + puts stderr "ARGV: $argv" pdtk_post "Starting pd.tk with main($argc $argv)" init
Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -50,6 +50,9 @@
# Tcl event bindings wm protocol . WM_DELETE_WINDOW "menu_quit" + + # do window maintenance when entering the Pd window (Window menu, scrollbars, etc) + #bind $name <Enter> {pdtk_pdwindowmaintenance} }
proc ::pd_bindings::panel_bindings {name} { @@ -60,6 +63,8 @@ # bind $name <KeyPress-Escape> [format "%s_cancel %s" $panelname $name] # bind $name <KeyPress-Return> [format "%s_ok %s" $panelname $name] # bind $name <$modifier_key-Key-w> [format "%s_cancel %s" $panelname $name] + +# wm protocol $name WM_DELETE_WINDOW "$panelname_cancel" }
proc ::pd_bindings::canvas_bindings {name} { @@ -104,9 +109,12 @@ bind $name <Control-Key-t> "menu_texteditor $name" }
+ # TODO add mouse button bindings + + # do window maintenance when entering a window (Window menu, scrollbars, etc) + #bind $name <Enter> {pdtk_canvaswindowmaintenance} + # 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_menucommands.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -53,6 +53,14 @@ }
# ------------------------------------------------------------------------------ +# functions called from Edit menu + +proc ::pd_menucommands::menu_preferences {args} { + toplevel .preferences + wm title .preferences "Preferences" +} + +# ------------------------------------------------------------------------------ # window management functions
Modified: branches/pd-devel/0.41.4/src/pd_menus.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pd_menus.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -29,10 +29,13 @@ namespace export configure_pdwindow
if {[tk windowingsystem] eq "aqua"} { - set accelerator "Meta" + set accelerator "Cmd" } else { set accelerator "Ctrl" } + + # turn off tearoff menus globally + option add *tearOff 0 }
# ------------------------------------------------------------------------------ @@ -47,7 +50,7 @@ $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 "Save All"] $rootmenu add command -label [say "Revert to Saved"] $rootmenu add separator $rootmenu add command -label [say "Message"] @@ -183,6 +186,11 @@ # if { $editable == 0 } { # $name.m.edit entryconfigure "Edit mode" -indicatoron false # } + if {[tk windowingsystem] ne "aqua"} { + $rootmenu add separator + $rootmenu add command -label [say "Preferences"] \ + -command "menu_preferences" + } }
proc ::pd_menus::create_put_menu {rootmenu name} { @@ -269,29 +277,39 @@ -command "placeholder menu_helpbrowser $help_top_directory" }
-proc ::pd_menus::create_apple_menu {rootmenu name} { - $rootmenu add command -label [say "About Pd..."] -command \ + +# for the Apple application menu on Mac OS X +# proc ::tk::mac::ShowPreferences {} { +# puts stderr "apple prefs menu item callback" +# puts stderr "::tk::mac::ShowPreferences " +# menu_preferences +# } + +# for Mac OS X only +proc ::pd_menus::make_apple_menu {rootmenu} { + puts stderr CREATE_APPLE_MENU + # TODO this should open a Pd patch called about.pd + menu .menubar.apple + .menubar.apple add command -label [say "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 [say "Path..."] \ - -command {pd pd start-path-dialog ;} - $rootmenu.preferences add command -label [say "Startup..."] \ - -command {pd pd start-startup-dialog ;} - $rootmenu.preferences add command -label [say "Audio Settings..."] \ - -command {pd pd audio-properties ;} - $rootmenu.preferences add command -label [say "MIDI settings..."] \ - -command {pd pd midi-properties ;} + .menubar add cascade -label "Apple" -menu .menubar.apple + # TODO WTF?!? the preferences menu never shows up! }
+# for Windows only +proc ::pd_menus::make_system_menu {rootmenu} { + $rootmenu add cascade -menu [menu $rootmenu.system] + # TODO add Close, Minimize, etc and whatever else is on the little menu + # that is on the top left corner of the window frame +} + proc ::pd_menus::create_menubar {rootmenu} { menu $rootmenu set menulist "file edit put find media window help" - if { [tk windowingsystem] eq "aqua" } { - set menulist "$menulist apple" - } + if { [tk windowingsystem] eq "aqua" } {make_apple_menu $rootmenu} + if { [tk windowingsystem] eq "win32" } {make_system_menu $rootmenu} foreach menuitem $menulist { - menu $rootmenu.$menuitem -tearoff 0 + menu $rootmenu.$menuitem $rootmenu add cascade -label [string totitle $menuitem] \ -menu $rootmenu.$menuitem [format create_%s_menu $menuitem] $rootmenu.$menuitem PLACEHOLDER
Modified: branches/pd-devel/0.41.4/src/pkgIndex.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -1,5 +1,5 @@ # Tcl package index file, version 1.1 -# This file is generated by the "pkg_mkIndex -lazy" command +# This file is generated by the "pkg_mkIndex" command # and sourced either when an application starts up or # by a "package unknown" script. It invokes the # "package ifneeded" command to set up package-related @@ -8,11 +8,11 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory.
-package ifneeded pd_bindings 0.1 [list tclPkgSetup $dir pd_bindings 0.1 {{pd_bindings.tcl source {::pd_bindings::canvas_bindings ::pd_bindings::panel_bindings ::pd_bindings::window_bindings}}}] -package ifneeded pd_connect 0.1 [list tclPkgSetup $dir pd_connect 0.1 {{pd_connect.tcl source {::pd_connect::connect_to_pd ::pd_connect::pd}}}] -package ifneeded pd_iemgui 0.1 [list tclPkgSetup $dir pd_iemgui 0.1 {{pd_iemgui.tcl source ::pd_iemgui::pdtk_iemgui_dialog}}] -package ifneeded pd_menucommands 0.1 [list tclPkgSetup $dir pd_menucommands 0.1 {{pd_menucommands.tcl source {::pd_menucommands::menu_bringalltofront ::pd_menucommands::menu_close ::pd_menucommands::menu_maximize ::pd_menucommands::menu_minimize ::pd_menucommands::menu_new ::pd_menucommands::menu_open}}}] -package ifneeded pd_post 0.1 [list tclPkgSetup $dir pd_post 0.1 {{pd_post.tcl source ::pd_post::pdtk_post}}] -package ifneeded pd_say 0.1 [list tclPkgSetup $dir pd_say 0.1 {{pd_say.tcl source {init_locale say say2 say_category say_namespace}}}] -package ifneeded wheredoesthisgo 0.1 [list tclPkgSetup $dir wheredoesthisgo 0.1 {{wheredoesthisgo.tcl source placeholder}}] +package ifneeded pd_bindings 0.1 [list source [file join $dir pd_bindings.tcl]] +package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]] +package ifneeded pd_iemgui 0.1 [list source [file join $dir pd_iemgui.tcl]] +package ifneeded pd_menucommands 0.1 [list source [file join $dir pd_menucommands.tcl]] package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]] +package ifneeded pd_post 0.1 [list source [file join $dir pd_post.tcl]] +package ifneeded pd_say 0.1 [list source [file join $dir pd_say.tcl]] +package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
Modified: branches/pd-devel/0.41.4/src/pkg_mkIndex.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pkg_mkIndex.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/pkg_mkIndex.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -1,7 +1,7 @@ #!/usr/bin/tclsh
puts stdout "Watch out, this doesn't work on packages with namespace import" -pkg_mkIndex -lazy -verbose -- [pwd] *.tcl *.[info sharedlibextension] +pkg_mkIndex -verbose -- [pwd] *.tcl *.[info sharedlibextension]
## this currently needs to be added to pkg_mkIndex manually, ug #package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
Modified: branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl =================================================================== --- branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-09 00:38:11 UTC (rev 10491) +++ branches/pd-devel/0.41.4/src/wheredoesthisgo.tcl 2009-01-09 05:10:16 UTC (rev 10492) @@ -1,13 +1,31 @@
package provide wheredoesthisgo 0.1
-# a place to temporarily store things until they find a home +# a place to temporarily store things until they find a home or go away
set help_top_directory ""
+ +proc post_tclinfo {} { + pdtk_post [concat Tcl library: [info library]] + pdtk_post [concat executable: [info nameofexecutable]] + pdtk_post [concat tclversion: [info tclversion]] + pdtk_post [concat patchlevel: [info patchlevel]] + pdtk_post [concat sharedlibextension: [info sharedlibextension]] +} + + proc placeholder {args} { # PLACEHOLDER ::pd_post::pdtk_post "PLACEHOLDER $args" }
+ +# ------------------------------------------------------------------------------ +# 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 +}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.