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

eighthave at users.sourceforge.net eighthave at users.sourceforge.net
Fri Jan 9 06:10:16 CET 2009


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.




More information about the Pd-cvs mailing list