[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