From 2c0d129dc28c54965b0985f8aec348b8b4006638 Mon Sep 17 00:00:00 2001
From: Ivica Ico Bukvic <ico@vt.edu>
Date: Mon, 16 Sep 2013 21:34:58 -0400
Subject: [PATCH] *added adapted backport of recent files feature *code
clean-up *brought the rest of disabled tcl files up-to-date with the 0.45
branch for possible future merge
---
pd/src/makefile.in | 3 +-
pd/src/pd.tk | 64 +++-
pd/src/pd_guiprefs.tcl | 250 ++++++++++++++++
pd/src/pd_menus.tcl | 473 ------------------------------
pd/src/pd_menus_SHORT.tcl | 90 ++++++
pd/src/pkgIndex.tcl | 2 +
pd/tcl/AppMain.tcl | 9 -
pd/tcl/Makefile.am | 16 +
pd/tcl/apple_events.tcl | 50 ++--
pd/tcl/dialog_array.tcl | 21 +-
pd/tcl/dialog_audio.tcl | 251 +++++++++-------
pd/tcl/dialog_canvas.tcl | 26 +-
pd/tcl/dialog_data.tcl | 53 ++++
pd/tcl/dialog_find.tcl | 145 ++++++---
pd/tcl/dialog_font.tcl | 61 ++--
pd/tcl/dialog_gatom.tcl | 45 +--
pd/tcl/dialog_iemgui.tcl | 107 ++++---
pd/tcl/dialog_message.tcl | 85 ++++++
pd/tcl/dialog_midi.tcl | 15 +-
pd/tcl/dialog_path.tcl | 70 +++++
pd/tcl/dialog_startup.tcl | 96 ++++++
pd/tcl/helpbrowser.tcl | 272 +++++++++++++++++
pd/tcl/opt_parser.tcl | 40 ++-
pd/tcl/pd-gui.tcl | 584 ++++++++++++++++++++++++++-----------
pd/tcl/pd.ico | Bin 0 -> 25214 bytes
pd/tcl/pd_bindings.tcl | 305 +++++++++----------
pd/tcl/pd_connect.tcl | 90 +++---
pd/tcl/pd_guiprefs.tcl | 249 ++++++++++++++++
pd/tcl/pd_menucommands.tcl | 227 ++++++++------
pd/tcl/pd_menus.tcl | 482 +++++++++++++++++++-----------
pd/tcl/pd_menus.tcl~ | 473 ------------------------------
pd/tcl/pdtk_canvas.tcl | 355 +++++++++++++++++-----
pd/tcl/pdtk_text.tcl | 56 +++-
pd/tcl/pdtk_textwindow.tcl | 103 +++++++
pd/tcl/pdwindow.tcl | 403 +++++++++++++++++++++++--
pd/tcl/pkgIndex.tcl | 9 +
pd/tcl/scrollbox.tcl | 191 ++++++++++++
pd/tcl/scrollboxwindow.tcl | 94 ++++++
pd/tcl/wheredoesthisgo.tcl | 124 ++++----
39 files changed, 3918 insertions(+), 2071 deletions(-)
create mode 100644 pd/src/pd_guiprefs.tcl
delete mode 100644 pd/src/pd_menus.tcl
create mode 100644 pd/src/pd_menus_SHORT.tcl
create mode 100644 pd/tcl/Makefile.am
create mode 100644 pd/tcl/dialog_data.tcl
create mode 100644 pd/tcl/dialog_message.tcl
create mode 100644 pd/tcl/dialog_path.tcl
create mode 100644 pd/tcl/dialog_startup.tcl
create mode 100644 pd/tcl/helpbrowser.tcl
create mode 100755 pd/tcl/pd.ico
create mode 100644 pd/tcl/pd_guiprefs.tcl
delete mode 100644 pd/tcl/pd_menus.tcl~
create mode 100644 pd/tcl/pdtk_textwindow.tcl
create mode 100644 pd/tcl/scrollbox.tcl
create mode 100644 pd/tcl/scrollboxwindow.tcl
diff --git a/pd/src/makefile.in b/pd/src/makefile.in
index 853c6a1e8..a0dc46c73 100644
--- a/pd/src/makefile.in
+++ b/pd/src/makefile.in
@@ -207,8 +207,7 @@ install: all tkpath tkdnd
install $(BIN_DIR)/$(GUINAME) $(DESTDIR)$(libpdbindir)/$(GUINAME)
install $(BIN_DIR)/pd-watchdog $(DESTDIR)$(libpdbindir)/pd-watchdog
install -m644 pd.tk $(DESTDIR)$(libpdbindir)/pd.tk
- install -m644 pkgIndex.tcl $(DESTDIR)$(libpdbindir)/pkgIndex.tcl
- install -m644 helpbrowser.tcl $(DESTDIR)$(libpdbindir)/helpbrowser.tcl
+ install -m644 *.tcl $(DESTDIR)$(libpdbindir)/
install -m644 ../tkpath/library/tkpath.tcl $(DESTDIR)$(libpdbindir)/tkpath.tcl
install -m644 ../tkpath/libtkpath*so $(DESTDIR)$(libpdbindir)/
install -m644 ../tkdnd/library/tkdnd.tcl $(DESTDIR)$(libpdbindir)/tkdnd.tcl
diff --git a/pd/src/pd.tk b/pd/src/pd.tk
index a422e10db..f097887aa 100644
--- a/pd/src/pd.tk
+++ b/pd/src/pd.tk
@@ -619,6 +619,12 @@ set help_top_directory $pd_guidir/doc
#==============================================================================#
# pd-gui-rewrite-0.43 help browser backport
+switch -- $pd_nt {
+ 0 { set ::windowingsystem "x11" }
+ 1 { set ::windowingsystem "win32" }
+ 2 { set ::windowingsystem "aqua" }
+}
+
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
# the pd-gui-rewrite-0.43 help browser is backported to Pd-extended 0.42
@@ -626,6 +632,15 @@ package require helpbrowser
package require msgcat
package require tkpng
package require tkdnd
+package require pd_guiprefs
+package require pd_menus
+
+namespace import ::pd_guiprefs::init
+namespace import ::pd_guiprefs::update_recentfiles
+namespace import ::pd_guiprefs::write_recentfiles
+
+set total_recentfiles 5
+::pd_guiprefs::init
# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}
@@ -659,7 +674,7 @@ ttk::style configure IOErrorOff.TButton -background lightgrey
ttk::style map IOErrorOff.TButton -background [list active $colors(-frame)]
match_linux_wm [list menu .mbar -relief flat]
-match_linux_wm [list menu .mbar.file -tearoff $pd_tearoff]
+match_linux_wm [list menu .mbar.file -tearoff $pd_tearoff -postcommand [concat pdtk_fixfilemenu .mbar.file]]
.mbar add cascade -label File -menu .mbar.file
match_linux_wm [list menu .mbar.edit -tearoff $pd_tearoff]
.mbar add cascade -label Edit -menu .mbar.edit
@@ -1041,6 +1056,10 @@ proc pdtk_canvas_menuclose {window reply} {
}
}
+proc pdtk_fixfilemenu {name} {
+ ::pd_menus::update_recentfiles_menu $name false
+}
+
set menu_windowlist {}
proc pdtk_fixwindowmenu {} {
@@ -1183,6 +1202,7 @@ proc open_file {filename} {
if {[regexp -nocase -- "\.(pd|pat|mxt)$" $basename]} {
pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
set pd_opendir $directory
+ ::pd_guiprefs::update_recentfiles $filename 1
}
}
@@ -1543,13 +1563,11 @@ proc menu_addstd {mbar} {
.mbar.file add command -label Open -command {menu_open} \
-accelerator [accel_munge "Ctrl+o"]
match_linux_wm [list .mbar.file add separator]
-.mbar.file add command -label Close -accelerator [accel_munge "Ctrl+w"] \
- -state disabled
.mbar.file add command -label Save -accelerator [accel_munge "Ctrl+s"] \
-state disabled
.mbar.file add command -label "Save as..." -accelerator [accel_munge "Ctrl+S"] \
-state disabled
-match_linux_wm [list .mbar.file add separator]
+match_linux_wm [list .mbar.file add separator]
if {$pd_nt != 2} {
.mbar.file add command -label "Message..." -command {menu_send} \
-accelerator [accel_munge "Ctrl+m"]
@@ -1570,11 +1588,21 @@ if {$pd_nt != 2} {
match_linux_wm [list .mbar.file add separator]
.mbar.file add command -label "Print..." -accelerator [accel_munge "Ctrl+p"] \
-state disabled
-if {$pd_nt != 2} {
-# Mac OS X doesn't put Quit on the File menu
+
+# update recent files
+match_linux_wm [list .mbar.file add separator]
+#if {[llength $::recentfiles_list] > 0} {
+# ::pd_menus::update_recentfiles_menu .mbar.file false
+#}
+
match_linux_wm [list .mbar.file add separator]
-.mbar.file add command -label Quit -command {menu_quit} \
- -accelerator [accel_munge "Ctrl+q"]
+.mbar.file add command -label Close -accelerator [accel_munge "Ctrl+w"] \
+ -state disabled
+
+if {$pd_nt != 2} {
+ # Mac OS X doesn't put Quit on the File menu
+ .mbar.file add command -label Quit -command {menu_quit} \
+ -accelerator [accel_munge "Ctrl+q"]
}
#################### the "Edit" menu for the Pd window ##############
@@ -2765,7 +2793,7 @@ proc pdtk_canvas_new {name width height geometry editable} {
# For the main window, they are created on load, at the
# top of this file.
match_linux_wm [list menu $name.m -relief flat]
- match_linux_wm [list menu $name.m.file -tearoff $pd_tearoff]
+ match_linux_wm [list menu $name.m.file -postcommand [concat pdtk_fixfilemenu $name.m.file] -tearoff $pd_tearoff]
$name.m add cascade -label File -menu $name.m.file
$name.m.file add command -label New -command {menu_new} \
@@ -2779,9 +2807,6 @@ proc pdtk_canvas_new {name width height geometry editable} {
}
match_linux_wm [list $name.m.file add separator]
- $name.m.file add command -label Close \
- -command [concat menu_close $name] \
- -accelerator [accel_munge "Ctrl+w"]
$name.m.file add command -label Save -command [concat menu_save $name] \
-accelerator [accel_munge "Ctrl+s"]
@@ -2814,9 +2839,20 @@ proc pdtk_canvas_new {name width height geometry editable} {
$name.m.file add command -label "Print..." -command [concat menu_print $name] \
-accelerator [accel_munge "Ctrl+p"]
}
+ # update recent files
+ match_linux_wm [list $name.m.file add separator]
+ #match_linux_wm [list $name.m.file add separator]
+ #if {[llength $::recentfiles_list] > 0} {
+ # ::pd_menus::update_recentfiles_menu $name.m.file false
+ #}
+
+ match_linux_wm [list $name.m.file add separator]
+ $name.m.file add command -label Close \
+ -command [concat menu_close $name] \
+ -accelerator [accel_munge "Ctrl+w"]
+
if {$pd_nt != 2} {
# Mac OS X doesn't put Quit on the File menu
- match_linux_wm [list $name.m.file add separator]
$name.m.file add command -label Quit -command {menu_quit} \
-accelerator [accel_munge "Ctrl+q"]
}
@@ -4722,6 +4758,8 @@ proc pdtk_canvas_saveas {name initfile initdir} {
[pdtk_enquote $directory] \;]
# pd [concat $name savetofile $basename $directory \;]
set untitled_directory $directory
+ # add to recentfiles
+ ::pd_guiprefs::update_recentfiles $filename 1
}
# zooming (a subset of dofont)
diff --git a/pd/src/pd_guiprefs.tcl b/pd/src/pd_guiprefs.tcl
new file mode 100644
index 000000000..f97d2b45e
--- /dev/null
+++ b/pd/src/pd_guiprefs.tcl
@@ -0,0 +1,250 @@
+#
+# Copyright (c) 1997-2009 Miller Puckette.
+# Copyright (c) 2011 Yvan Volochine.
+#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
+
+package provide pd_guiprefs 0.1
+
+
+namespace eval ::pd_guiprefs:: {
+ namespace export init
+ namespace export write_recentfiles
+ namespace export update_recentfiles
+}
+
+# FIXME should these be globals ?
+set ::recentfiles_key ""
+set ::recentfiles_domain ""
+
+
+#################################################################
+# global procedures
+#################################################################
+# ------------------------------------------------------------------------------
+# init preferences
+#
+proc ::pd_guiprefs::init {} {
+ switch -- $::windowingsystem {
+ "aqua" { init_aqua }
+ "win32" { init_win }
+ "x11" { init_x11 }
+ }
+ # assign gui preferences
+ # osx special case for arrays
+ set arr [expr { $::windowingsystem eq "aqua" }]
+ set ::recentfiles_list ""
+ catch {set ::recentfiles_list [get_config $::recentfiles_domain \
+ $::recentfiles_key $arr]}
+}
+
+proc ::pd_guiprefs::init_aqua {} {
+ # osx has a "Open Recent" menu with 10 recent files (others have 5 inlined)
+ set ::recentfiles_domain org.puredata
+ set ::recentfiles_key "NSRecentDocuments"
+ set ::total_recentfiles 10
+}
+
+proc ::pd_guiprefs::init_win {} {
+ # windows uses registry
+ set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pd-L2Ork"
+ set ::recentfiles_key "RecentDocs"
+}
+
+proc ::pd_guiprefs::init_x11 {} {
+ # linux uses ~/.config/pure-data dir
+ set ::recentfiles_domain "~/.config/pd-l2ork"
+ set ::recentfiles_key "recentfiles.conf"
+ prepare_configdir
+}
+
+# ------------------------------------------------------------------------------
+# write recent files
+#
+proc ::pd_guiprefs::write_recentfiles {} {
+ write_config $::recentfiles_list $::recentfiles_domain $::recentfiles_key true
+}
+
+# ------------------------------------------------------------------------------
+# this is called when opening a document (wheredoesthisshouldgo.tcl)
+#
+proc ::pd_guiprefs::update_recentfiles {afile save} {
+ # remove duplicates first
+ set index [lsearch -exact $::recentfiles_list $afile]
+ set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
+ # insert new one in the beginning and crop the list
+ set ::recentfiles_list [linsert $::recentfiles_list 0 $afile]
+ set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles]
+ #::pd_menus::update_recentfiles_menu .mbar.file $save
+ ::pd_guiprefs::write_recentfiles
+}
+
+#################################################################
+# main read/write procedures
+#################################################################
+
+# ------------------------------------------------------------------------------
+# get configs from a file or the registry
+#
+proc ::pd_guiprefs::get_config {adomain {akey} {arr}} {
+ switch -- $::windowingsystem {
+ "aqua" { set conf [get_config_aqua $adomain $akey $arr] }
+ "win32" { set conf [get_config_win $adomain $akey $arr] }
+ "x11" { set conf [get_config_x11 $adomain $akey $arr] }
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# write configs to a file or to the registry
+# $arr is true if the data needs to be written in an array
+#
+proc ::pd_guiprefs::write_config {data {adomain} {akey} {arr false}} {
+ switch -- $::windowingsystem {
+ "aqua" { write_config_aqua $data $adomain $akey $arr }
+ "win32" { write_config_win $data $adomain $akey $arr }
+ "x11" { write_config_x11 $data $adomain $akey }
+ }
+}
+
+#################################################################
+# os specific procedures
+#################################################################
+
+# ------------------------------------------------------------------------------
+# osx: read a plist file
+#
+proc ::pd_guiprefs::get_config_aqua {adomain {akey} {arr false}} {
+ if {![catch {exec defaults read $adomain $akey} conf]} {
+ if {$arr} {
+ set conf [plist_array_to_tcl_list $conf]
+ }
+ } else {
+ # initialize NSRecentDocuments with an empty array
+ exec defaults write $adomain $akey -array
+ set conf {}
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# win: read in the registry
+#
+proc ::pd_guiprefs::get_config_win {adomain {akey} {arr false}} {
+ package require registry
+ if {![catch {registry get $adomain $akey} conf]} {
+ return [expr {$conf}]
+ } else {
+ return {}
+ }
+}
+
+# ------------------------------------------------------------------------------
+# linux: read a config file and return its lines splitted.
+#
+proc ::pd_guiprefs::get_config_x11 {adomain {akey} {arr false}} {
+ set filename [file join $adomain $akey]
+ set conf {}
+ if {
+ [file exists $filename] == 1
+ && [file readable $filename]
+ } {
+ set fl [open $filename r]
+ while {[gets $fl line] >= 0} {
+ lappend conf $line
+ }
+ close $fl
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# osx: write configs to plist file
+# if $arr is true, we write an array
+#
+proc ::pd_guiprefs::write_config_aqua {data {adomain} {akey} {arr false}} {
+ # FIXME empty and write again so we don't loose the order
+ if {[catch {exec defaults write $adomain $akey -array} errorMsg]} {
+ ::pdwindow::error "write_config_aqua $akey: $errorMsg"
+ }
+ if {$arr} {
+ foreach filepath $data {
+ set escaped [escape_for_plist $filepath]
+ exec defaults write $adomain $akey -array-add "$escaped"
+ }
+ } else {
+ set escaped [escape_for_plist $data]
+ exec defaults write $adomain $akey '$escaped'
+ }
+}
+
+# ------------------------------------------------------------------------------
+# win: write configs to registry
+# if $arr is true, we write an array
+#
+proc ::pd_guiprefs::write_config_win {data {adomain} {akey} {arr false}} {
+ package require registry
+ # FIXME: ugly
+ if {$arr} {
+ if {[catch {registry set $adomain $akey $data multi_sz} errorMsg]} {
+ ::pdwindow::error "write_config_win $data $akey: $errorMsg"
+ }
+ } else {
+ if {[catch {registry set $adomain $akey $data sz} errorMsg]} {
+ ::pdwindow::error "write_config_win $data $akey: $errorMsg"
+ }
+ }
+}
+
+# ------------------------------------------------------------------------------
+# linux: write configs to USER_APP_CONFIG_DIR
+#
+proc ::pd_guiprefs::write_config_x11 {data {adomain} {akey}} {
+ # right now I (yvan) assume that data are just \n separated, i.e. no keys
+ set data [join $data "\n"]
+ set filename [file join $adomain $akey]
+ if {[catch {set fl [open $filename w]} errorMsg]} {
+ ::pdwindow::error "write_config_x11 $data $akey: $errorMsg"
+ } else {
+ puts -nonewline $fl $data
+ close $fl
+ }
+}
+
+#################################################################
+# utils
+#################################################################
+
+# ------------------------------------------------------------------------------
+# linux only! : look for pd config directory and create it if needed
+#
+proc ::pd_guiprefs::prepare_configdir {} {
+ if {[file isdirectory $::recentfiles_domain] != 1} {
+ file mkdir $::recentfiles_domain
+ ::pdwindow::debug "$::recentfiles_domain was created.\n"
+ }
+}
+
+# ------------------------------------------------------------------------------
+# osx: handles arrays in plist files (thanks hc)
+#
+proc ::pd_guiprefs::plist_array_to_tcl_list {arr} {
+ set result {}
+ set filelist $arr
+ regsub -all -- {("?),\s+("?)} $filelist {\1 \2} filelist
+ regsub -all -- {\n} $filelist {} filelist
+ regsub -all -- {^\(} $filelist {} filelist
+ regsub -all -- {\)$} $filelist {} filelist
+ regsub -line -- {^'(.*)'$} $filelist {\1} filelist
+
+ foreach file $filelist {
+ set filename [regsub -- {,$} $file {}]
+ lappend result $filename
+ }
+ return $result
+}
+
+# the Mac OS X 'defaults' command uses single quotes to quote things,
+# so they need to be escaped
+proc ::pd_guiprefs::escape_for_plist {str} {
+ return [regsub -all -- {'} $str {\\'}]
+}
diff --git a/pd/src/pd_menus.tcl b/pd/src/pd_menus.tcl
deleted file mode 100644
index d9b459a92..000000000
--- a/pd/src/pd_menus.tcl
+++ /dev/null
@@ -1,473 +0,0 @@
-# Copyright (c) 1997-2009 Miller Puckette.
-#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
-
-package provide pd_menus 0.1
-
-package require pd_menucommands
-package require Tk
-#package require tile
-## replace Tk widgets with Ttk widgets on 8.5
-#namespace import -force ttk::*
-
-# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
-# TODO figure out parent window/window list for Window menu
-# TODO what is the Tcl package constructor or init()?
-# TODO $::pd_menus::menubar or .menubar globally?
-
-# since there is one menubar that is used for all windows, the menu -commands
-# use {} quotes so that $::focused_window is interpreted when the menu item
-# is called, not when the command is mapped to the menu item. This is the
-# opposite of the 'bind' commands in pd_bindings.tcl
-
-
-# ------------------------------------------------------------------------------
-# global variables
-
-# TODO this should properly be inside the pd_menus namespace, now it is global
-namespace import ::pd_menucommands::*
-
-namespace eval ::pd_menus:: {
- variable accelerator
- variable menubar ".menubar"
- variable current_toplevel ".pdwindow"
-
- namespace export create_menubar
- namespace export configure_for_pdwindow
- namespace export configure_for_canvas
- namespace export configure_for_dialog
-
- # turn off tearoff menus globally
- option add *tearOff 0
-}
-
-# ------------------------------------------------------------------------------
-#
-proc ::pd_menus::create_menubar {} {
- variable accelerator
- variable menubar
- if {$::windowingsystem eq "aqua"} {
- set accelerator "Cmd"
- } else {
- set accelerator "Ctrl"
- }
- menu $menubar
- set menulist "file edit put find media window help"
- if { $::windowingsystem eq "aqua" } {create_apple_menu $menubar}
- # FIXME why does the following (if uncommented) kill my menubar?
- # if { $::windowingsystem eq "win32" } {create_system_menu $menubar}
- foreach mymenu $menulist {
- menu $menubar.$mymenu
- $menubar add cascade -label [_ [string totitle $mymenu]] \
- -menu $menubar.$mymenu
- [format build_%s_menu $mymenu] $menubar.$mymenu .
- if {$::windowingsystem eq "win32"} {
- # fix menu font size on Windows with tk scaling = 1
- $menubar.$mymenu configure -font menufont
- }
- }
-}
-
-proc ::pd_menus::configure_for_pdwindow {} {
- variable menubar
- # these are meaningless for the Pd window, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
- # disable everything on the Put menu
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-proc ::pd_menus::configure_for_canvas {mytoplevel} {
- variable menubar
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state normal
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state normal
- }
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state normal }
- }
- # TODO set "Edit Mode" state using editmode($mytoplevel)
-}
-
-proc ::pd_menus::configure_for_dialog {mytoplevel} {
- variable menubar
- # these are meaningless for the dialog panels, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
- # disable everything on the Put menu
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-
-# ------------------------------------------------------------------------------
-# menu building functions
-proc ::pd_menus::build_file_menu {mymenu mytoplevel} {
- [format build_file_menu_%s $::windowingsystem] $mymenu
- $mymenu entryconfigure [_ "New"] -command {menu_new}
- $mymenu entryconfigure [_ "Open"] -command {menu_open}
- $mymenu entryconfigure [_ "Save"] -command {pdsend "$::focused_window menusave"}
- $mymenu entryconfigure [_ "Save As..."] -command {pdsend "$::focused_window menusaveas"}
- #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $current_toplevel}
- $mymenu entryconfigure [_ "Close"] -command {pdsend "$::focused_window menuclose 0"}
- $mymenu entryconfigure [_ "Message"] -command {menu_message_dialog}
- $mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window}
-}
-
-proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
- -command {menu_undo $::focused_window}
- $mymenu add command -label [_ "Redo"] -accelerator "Shift+$accelerator+Z" \
- -command {menu_redo $::focused_window}
- $mymenu add separator
- $mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
- -command {pdsend "$::focused_window cut"}
- $mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
- -command {pdsend "$::focused_window copy"}
- $mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
- -command {pdsend "$::focused_window paste"}
- $mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
- -command {pdsend "$::focused_window duplicate"}
- $mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
- -command {pdsend "$::focused_window selectall"}
- $mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Text Editor"] \
- -command {menu_texteditor $::focused_window}
- $mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
- -command {menu_font_dialog $::focused_window}
- } else {
- $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
- -command {menu_texteditor $::focused_window}
- $mymenu add command -label [_ "Font"] \
- -command {menu_font_dialog $::focused_window}
- }
- $mymenu add command -label [_ "Tidy Up"] \
- -command {pdsend "$::focused_window tidy"}
- $mymenu add command -label [_ "Toggle Console"] -accelerator "Shift+$accelerator+R" \
- -command {.controls.switches.console invoke}
- $mymenu add command -label [_ "Clear Console"] -accelerator "Shift+$accelerator+L" \
- -command {menu_clear_console}
- $mymenu add separator
- $mymenu add checkbutton -label [_ "Edit mode"] \
- -accelerator "$accelerator+E" -variable ::editmode_button \
- -command {menu_editmode $::editmode_button}
- -command {pdsend "$::focused_window editmode 0"}
- #if { ! [catch {console hide}]} {
- # TODO set up menu item to show/hide the Tcl/Tk console, if it available
- #}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add separator
- $mymenu add command -label [_ "Preferences"] \
- -command {menu_preferences_dialog}
- }
-}
-
-proc ::pd_menus::build_put_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
- -command {pdsend "$::focused_window obj 0"}
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
- -command {pdsend "$::focused_window msg 0"}
- $mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
- -command {pdsend "$::focused_window floatatom 0"}
- $mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
- -command {pdsend "$::focused_window symbolatom 0"}
- $mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
- -command {pdsend "$::focused_window text 0"}
- $mymenu add separator
- $mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
- -command {pdsend "$::focused_window bng 0"}
- $mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
- -command {pdsend "$::focused_window toggle 0"}
- $mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
- -command {pdsend "$::focused_window numbox 0"}
- $mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
- -command {pdsend "$::focused_window vslider 0"}
- $mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
- -command {pdsend "$::focused_window hslider 0"}
- $mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
- -command {pdsend "$::focused_window vradio 0"}
- $mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
- -command {pdsend "$::focused_window hradio 0"}
- $mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
- -command {pdsend "$::focused_window vumeter 0"}
- $mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
- -command {pdsend "$::focused_window mycnv 0"}
- $mymenu add separator
- $mymenu add command -label [_ "Graph"] -command {pdsend "$::focused_window graph"}
- $mymenu add command -label [_ "Array"] -command {pdsend "$::focused_window menuarray"}
-}
-
-proc ::pd_menus::build_find_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
- -command {::dialog_find::menu_find_dialog $::focused_window}
- $mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
- -command {pdsend "$::focused_window findagain"}
- $mymenu add command -label [_ "Find Last Error"] \
- -command {pdsend "$::focused_window finderror"}
-}
-
-proc ::pd_menus::build_media_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add radiobutton -label [_ "DSP On"] -accelerator "$accelerator+/" \
- -variable ::dsp -value 1 -command {pdsend "pd dsp 1"}
- $mymenu add radiobutton -label [_ "DSP Off"] -accelerator "$accelerator+." \
- -variable ::dsp -value 0 -command {pdsend "pd dsp 0"}
- $mymenu add separator
-
- set audioapi_list_length [llength $::audioapi_list]
- for {set x 0} {$x<$audioapi_list_length} {incr x} {
- # pdtk_post "audio [lindex [lindex $::audioapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::audioapi_list $x] 0] \
- -command {menu_audio 0} -variable ::pd_whichapi \
- -value [lindex [lindex $::audioapi_list $x] 1]\
- -command {pdsend "pd audio-setapi $::pd_whichapi"}
- }
- if {$audioapi_list_length > 0} {$mymenu add separator}
-
- set midiapi_list_length [llength $::midiapi_list]
- for {set x 0} {$x<$midiapi_list_length} {incr x} {
- # pdtk_post "midi [lindex [lindex $::midiapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::midiapi_list $x] 0] \
- -command {menu_midi 0} -variable ::pd_whichmidiapi \
- -value [lindex [lindex $::midiapi_list $x] 1]\
- -command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
- }
- if {$midiapi_list_length > 0} {$mymenu add separator}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "Audio settings..."] \
- -command {pdsend "pd audio-properties"}
- $mymenu add command -label [_ "MIDI settings..."] \
- -command {pdsend "pd midi-properties"}
- $mymenu add separator
- }
- $mymenu add command -label [_ "Test Audio and MIDI..."] \
- -command {menu_doc_open doc/7.stuff/tools testtone.pd}
- $mymenu add command -label [_ "Load Meter"] \
- -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
-}
-
-proc ::pd_menus::build_window_menu {mymenu mytoplevel} {
- variable accelerator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Minimize"] -command {menu_minimize .} \
- -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Zoom"] -command {menu_zoom .}
- $mymenu add separator
- }
- $mymenu add command -label [_ "Parent Window"] \
- -command {pdsend "$::focused_window findparent"}
- $mymenu add command -label [_ "Pd window"] -command {menu_raise_pdwindow} \
- -accelerator "$accelerator+R"
- $mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Bring All to Front"] \
- -command {menu_bringalltofront}
- $mymenu add separator
- }
-}
-
-proc ::pd_menus::build_help_menu {mymenu mytoplevel} {
- if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- }
- $mymenu add command -label [_ "HTML Manual..."] \
- -command {menu_doc_open doc/1.manual index.htm}
- $mymenu add command -label [_ "Browser..."] \
- -command {placeholder menu_helpbrowser \$help_top_directory}
-}
-
-# ------------------------------------------------------------------------------
-# update the menu entries for opening recent files
-proc ::pd_menus::update_recentfiles_menu {} {
- variable menubar
- switch -- $::windowingsystem {
- "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent}
- "win32" {update_recentfiles_on_menu $menubar.file}
- "x11" {update_recentfiles_on_menu $menubar.file}
- }
-}
-
-proc ::pd_menus::clear_recentfiles_menu {} {
- set ::recentfiles_list {}
- ::pd_menus::update_recentfiles_menu
-}
-
-proc ::pd_menus::update_openrecent_menu_aqua {mymenu} {
- if {! [winfo exists $mymenu]} {menu $mymenu}
- $mymenu delete 0 end
- foreach filename $::recentfiles_list {
- puts "creating menu item for $filename"
- $mymenu add command -label [file tail $filename] \
- -command "open_file $filename"
- }
- $mymenu add separator
- $mymenu add command -label [_ "Clear Menu"] \
- -command "::pd_menus::clear_recentfiles_menu"
-}
-
-# this expects to be run on the File menu, and to insert above the last separator
-proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
- set lastitem [$mymenu index end]
- set i 1
- while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
- set bottom_separator [expr $lastitem-$i]
- incr i
- while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
- set top_separator [expr $lastitem-$i]
- if {$top_separator < [expr $bottom_separator-1]} {
- $mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
- }
- set i 0
- foreach filename $::recentfiles_list {
- $mymenu insert [expr $top_separator+$i+1] command \
- -label [file tail $filename] -command "open_file $filename"
- incr i
- }
-}
-
-# ------------------------------------------------------------------------------
-# menu building functions for Mac OS X/aqua
-
-# for Mac OS X only
-proc ::pd_menus::create_apple_menu {mymenu} {
- # TODO this should open a Pd patch called about.pd
- menu $mymenu.apple
- $mymenu.apple add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- $mymenu add cascade -label "Apple" -menu $mymenu.apple
- $mymenu.apple add separator
- # starting in 8.4.14, this is created automatically
- set patchlevel [split [info patchlevel] .]
- if {[lindex $patchlevel 1] < 5 && [lindex $patchlevel 2] < 14} {
- $mymenu.apple add command -label [_ "Preferences..."] \
- -command {menu_preferences_dialog" -accelerator "Cmd+,}
- }
-}
-
-proc ::pd_menus::build_file_menu_aqua {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- ::pd_menus::update_openrecent_menu_aqua .openrecent
- $mymenu add cascade -label [_ "Open Recent"] -menu .openrecent
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "$accelerator+Shift+S"
- #$mymenu add command -label [_ "Save All"]
- #$mymenu add command -label [_ "Revert to Saved"]
- $mymenu add separator
- $mymenu add command -label [_ "Message"]
- $mymenu add separator
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_aqua {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_aqua {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
-# ------------------------------------------------------------------------------
-# menu building functions for UNIX/X11
-
-proc ::pd_menus::build_file_menu_x11 {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- $mymenu add separator
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
- # $mymenu add command -label "Revert"
- $mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
- $mymenu add separator
- # the recent files get inserted in here by update_recentfiles_on_menu
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q" \
- -command {pdsend "pd verifyquit"}
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_x11 {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_x11 {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
-# ------------------------------------------------------------------------------
-# menu building functions for Windows/Win32
-
-# for Windows only
-proc ::pd_menus::create_system_menu {mymenu} {
- $mymenu add cascade -menu [menu $mymenu.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::build_file_menu_win32 {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- $mymenu add separator
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
- # $mymenu add command -label "Revert"
- $mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
- $mymenu add separator
- # the recent files get inserted in here by update_recentfiles_on_menu
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q"\
- -command {pdsend "pd verifyquit"}
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_win32 {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_win32 {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
diff --git a/pd/src/pd_menus_SHORT.tcl b/pd/src/pd_menus_SHORT.tcl
new file mode 100644
index 000000000..1f00434e9
--- /dev/null
+++ b/pd/src/pd_menus_SHORT.tcl
@@ -0,0 +1,90 @@
+# Copyright (c) 1997-2009 Miller Puckette.
+#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
+
+package provide pd_menus 0.1
+
+#package require pd_menucommands
+
+# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
+
+# since there is one menubar that is used for all windows, the menu -commands
+# use {} quotes so that $::focused_window is interpreted when the menu item
+# is called, not when the command is mapped to the menu item. This is the
+# opposite of the 'bind' commands in pd_bindings.tcl
+
+namespace eval ::pd_menus:: {
+ variable accelerator
+ #variable menubar ".mbar"
+
+ namespace export create_menubar
+ namespace export configure_for_pdwindow
+ namespace export configure_for_canvas
+ namespace export configure_for_dialog
+
+ # turn off tearoff menus globally
+ option add *tearOff 0
+}
+
+# ------------------------------------------------------------------------------
+# update the menu entries for opening recent files (write arg should always be true except the first time when pd is opened)
+proc ::pd_menus::update_recentfiles_menu {menu {write true}} {
+ #variable menubar
+ switch -- $::windowingsystem {
+ "aqua" {::pd_menus::update_openrecent_menu_aqua $menu $write}
+ "win32" {::pd_menus::update_recentfiles_on_menu $menu $write}
+ "x11" {::pd_menus::update_recentfiles_on_menu $menu $write}
+ }
+}
+
+proc ::pd_menus::clear_recentfiles_menu {} {
+ set ::recentfiles_list {}
+ #::pd_menus::update_recentfiles_menu
+ # empty recentfiles in preferences (write empty array)
+ ::pd_guiprefs::write_recentfiles
+}
+
+proc ::pd_menus::update_openrecent_menu_aqua {mymenu {write}} {
+ if {! [winfo exists $mymenu]} {menu $mymenu}
+ $mymenu delete 0 end
+
+ # now the list is last first so we just add
+ foreach filename $::recentfiles_list {
+ $mymenu add command -label [file tail $filename] \
+ -command "open_file {$filename}"
+ }
+ # clear button
+ $mymenu add separator
+ $mymenu add command -label [_ "Clear Menu"] \
+ -command "::pd_menus::clear_recentfiles_menu"
+ # write to config file
+ if {$write == true} { ::pd_guiprefs::write_recentfiles }
+}
+
+# this expects to be run on the File menu, and to insert above the last separator
+proc ::pd_menus::update_recentfiles_on_menu {mymenu {write}} {
+ set lastitem [$mymenu index end]
+ set i 0
+ while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {incr i}
+ set bottom_separator [expr $lastitem-$i]
+ incr i
+
+ while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {incr i}
+ set top_separator [expr $lastitem-$i]
+ if {$top_separator < [expr $bottom_separator-1]} {
+ $mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
+ }
+ # insert the list from the end because we insert each element on the top
+ set i [llength $::recentfiles_list]
+ while {[incr i -1] > 0} {
+
+ set filename [lindex $::recentfiles_list $i]
+ $mymenu insert [expr $top_separator+1] command \
+ -label [file tail $filename] -command "open_file {$filename}"
+ }
+ set filename [lindex $::recentfiles_list 0]
+ $mymenu insert [expr $top_separator+1] command \
+ -label [file tail $filename] -command "open_file {$filename}"
+
+ # write to config file
+ if {$write == true} { ::pd_guiprefs::write_recentfiles }
+}
\ No newline at end of file
diff --git a/pd/src/pkgIndex.tcl b/pd/src/pkgIndex.tcl
index 41c87108d..29d492f0c 100644
--- a/pd/src/pkgIndex.tcl
+++ b/pd/src/pkgIndex.tcl
@@ -2,6 +2,8 @@
#
package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
+package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]]
+package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus_SHORT.tcl]]
namespace eval ::tkpath {
proc load_package {dir} {
diff --git a/pd/tcl/AppMain.tcl b/pd/tcl/AppMain.tcl
index b170c6f5c..7c68a9d04 100644
--- a/pd/tcl/AppMain.tcl
+++ b/pd/tcl/AppMain.tcl
@@ -3,17 +3,8 @@
# other configuration, like when 'pd' launches Wish.app or when 'pd' is using
# an X11 wish on Mac OS X. GNU/Linux and Windows will never use this file.
-
-puts --------------------------AppMain.tcl-----------------------------------
-catch {console show}
-
package require apple_events
-puts "AppMain.tcl"
-puts "argv0: $argv0"
-puts "executable: [info nameofexecutable]"
-puts "argc: $argc argv: $argv"
-
# TODO is there anything useful to do with the psn (Process Serial Number)?
if {[string first "-psn" [lindex $argv 0]] == 0} {
set argv [lrange $argv 1 end]
diff --git a/pd/tcl/Makefile.am b/pd/tcl/Makefile.am
new file mode 100644
index 000000000..3f7809e09
--- /dev/null
+++ b/pd/tcl/Makefile.am
@@ -0,0 +1,16 @@
+AUTOMAKE_OPTIONS = foreign
+
+SUFFIXES = .tcl
+
+# we want these in the dist tarball
+#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
+
+
+bin_SCRIPTS = pd-gui.tcl
+
+libpdtcldir = $(pkglibdir)/tcl
+dist_libpdtcl_SCRIPTS = pd-gui.tcl
+dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl pdtk_textwindow.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico
+
+etags: TAGS
+ etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl
diff --git a/pd/tcl/apple_events.tcl b/pd/tcl/apple_events.tcl
index cfc92982b..0311add73 100644
--- a/pd/tcl/apple_events.tcl
+++ b/pd/tcl/apple_events.tcl
@@ -1,53 +1,65 @@
package provide apple_events 0.1
+package require pdwindow
package require wheredoesthisgo
# from http://wiki.tcl.tk/12987
set ::tk::mac::CGAntialiasLimit 0 ;# min line thickness to anti-alias (default: 3)
-set ::tk::mac::antialiasedtext 1 ;# enable/disable anti-aliased text
+set ::tk::mac::antialiasedtext 1 ;# enable anti-aliased text
# kAEOpenDocuments
proc ::tk::mac::OpenDocument {args} {
- foreach filename $args {
- puts "open_file $filename"
- open_file $filename
+ foreach filename $args {
+ if {$::done_init} {
+ open_file $filename
+ } else {
+ lappend ::filestoopen_list $filename
+ }
}
set ::pd_menucommands::menu_open_dir [file dirname $filename]
}
# kEventAppHidden
-proc ::tk::mac::OnHide {} {
- # TODO
+proc ::tk::mac::OnHide {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OnHide $args +++++++++++++++++++++"
}
# kEventAppShown
-proc ::tk::mac::OnShow {} {
- # TODO
+proc ::tk::mac::OnShow {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OnShow $args +++++++++++++++++++++"
+}
+
+# open About Pd... in Tk/Cocoa
+proc tkAboutDialog {} {
+ menu_aboutpd
}
# kAEShowPreferences
-proc ::tk::mac::ShowPreferences {} {
- menu_preferences_dialog
+proc ::tk::mac::ShowPreferences {args} {
+ ::pdwindow::verbose 1 "::tk::mac::ShowPreferences $args ++++++++++++"
+ pdsend "pd start-path-dialog"
}
# kAEQuitApplication
-#proc ::tk::mac::Quit {} {
-# # TODO sort this out... how to quit pd-gui after sending the message
-# puts stderr "Custom exit proc"
-# pdsend "pd verifyquit"
+proc ::tk::mac::Quit {args} {
+ pdsend "pd verifyquit"
+}
+
+# on Tk/Cocoa, override the Apple Help menu
+#proc tk::mac::ShowHelp {args} {
#}
# these I gleaned by reading the source (tkMacOSXHLEvents.c)
proc ::tk::mac::PrintDocument {args} {
- # TODO what's $mytoplevel here?. I am guessing args would be the same as
- # ::tk::mac::OpenDocument
- #menu_print $mytoplevel
+ menu_print $::focused_window
}
-proc ::tk::mac::OpenApplication {} {
+proc ::tk::mac::OpenApplication {args} {
+ ::pdwindow::verbose 1 "::tk::mac::OpenApplication $args ++++++++++++"
}
-proc ::tk::mac::ReopenApplication {} {
+proc ::tk::mac::ReopenApplication {args} {
+ ::pdwindow::verbose 1 "::tk::mac::ReopenApplication $args ++++++++++"
}
diff --git a/pd/tcl/dialog_array.tcl b/pd/tcl/dialog_array.tcl
index 87b2de8ce..0f2696d2d 100644
--- a/pd/tcl/dialog_array.tcl
+++ b/pd/tcl/dialog_array.tcl
@@ -239,7 +239,6 @@ proc ::dialog_array::ok {mytoplevel} {
}
proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} {
-puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}"
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
@@ -262,7 +261,11 @@ puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}
proc ::dialog_array::create_dialog {mytoplevel newone} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Array Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "array"
frame $mytoplevel.name
@@ -315,14 +318,16 @@ proc ::dialog_array::create_dialog {mytoplevel newone} {
}
# end jsarlo
frame $mytoplevel.buttonframe
- pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ pack $mytoplevel.buttonframe -side bottom -expand 1 -fill x -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_array::cancel $mytoplevel"
- if {$newone == 0} {button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
- -command "::dialog_array::apply $mytoplevel"}
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
+ if {$newone == 0 && $::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
+ -command "::dialog_array::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttonframe.ok -text [_ "OK"]\
-command "::dialog_array::ok $mytoplevel"
- pack $mytoplevel.buttonframe.cancel -side left -expand 1
- if {$newone == 0} {pack $mytoplevel.buttonframe.apply -side left -expand 1}
- pack $mytoplevel.buttonframe.ok -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
}
diff --git a/pd/tcl/dialog_audio.tcl b/pd/tcl/dialog_audio.tcl
index 1025f66e0..56f18f455 100644
--- a/pd/tcl/dialog_audio.tcl
+++ b/pd/tcl/dialog_audio.tcl
@@ -4,19 +4,20 @@ namespace eval ::dialog_audio:: {
namespace export pdtk_audio_dialog
}
-# TODO this panel really needs some reworking, it works but the code is
-# very unreadable
+# TODO this panel really needs some reworking, it works but the code is very
+# unreadable. The panel could look a lot better too, like using menubuttons
+# instead of regular buttons with tk_popup for pulldown menus.
####################### audio dialog ##################3
-proc ::dialog_audio::apply {id} {
+proc ::dialog_audio::apply {mytoplevel} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
- global audio_sr audio_advance audio_callback
+ global audio_sr audio_advance audio_callback audio_blocksize
pdsend "pd audio-dialog \
$audio_indev1 \
@@ -37,16 +38,17 @@ proc ::dialog_audio::apply {id} {
[expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
$audio_sr \
$audio_advance \
- $audio_callback"
+ $audio_callback \
+ $audio_blocksize"
}
-proc ::dialog_audio::cancel {id} {
- pdsend "$id cancel"
+proc ::dialog_audio::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
}
-proc ::dialog_audio::ok {id} {
- ::dialog_audio::apply $id
- ::dialog_audio::cancel $id
+proc ::dialog_audio::ok {mytoplevel} {
+ ::dialog_audio::apply $mytoplevel
+ ::dialog_audio::cancel $mytoplevel
}
# callback from popup menu
@@ -78,18 +80,19 @@ proc audio_popup {name buttonname varname devlist} {
# opening several devices; if not, we get an extra button to turn longform
# on and restart the dialog.
-proc ::dialog_audio::pdtk_audio_dialog {id indev1 indev2 indev3 indev4 \
+proc ::dialog_audio::pdtk_audio_dialog {mytoplevel \
+ indev1 indev2 indev3 indev4 \
inchan1 inchan2 inchan3 inchan4 \
outdev1 outdev2 outdev3 outdev4 \
outchan1 outchan2 outchan3 outchan4 sr advance multi callback \
- longform} {
+ longform blocksize} {
global audio_indev1 audio_indev2 audio_indev3 audio_indev4
global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
- global audio_sr audio_advance audio_callback
+ global audio_sr audio_advance audio_callback audio_blocksize
global audio_indevlist audio_outdevlist
global pd_indev pd_outdev
global audio_longform
@@ -125,174 +128,196 @@ proc ::dialog_audio::pdtk_audio_dialog {id indev1 indev2 indev3 indev4 \
set audio_sr $sr
set audio_advance $advance
set audio_callback $callback
-
- toplevel $id
- wm title $id [_ "Audio Settings"]
- if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
- ::pd_bindings::dialog_bindings $id "audio"
-
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text [_ "Cancel"]\
- -command "::dialog_audio::cancel $id"
- button $id.buttonframe.apply -text [_ "Apply"]\
- -command "::dialog_audio::apply $id"
- button $id.buttonframe.ok -text [_ "OK"]\
- -command "::dialog_audio::ok $id"
- button $id.buttonframe.save -text [_ "Save all settings"]\
- -command "::dialog_audio::apply $id \; pdsend \"pd save-preferences\""
- pack $id.buttonframe.cancel $id.buttonframe.apply $id.buttonframe.ok \
- $id.buttonframe.save -side left -expand 1
+ set audio_blocksize $blocksize
+
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel [_ "Audio Settings"]
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 10 -pady 5
+ ::pd_bindings::dialog_bindings $mytoplevel "audio"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $mytoplevel -topmost 1}
+
+ frame $mytoplevel.buttonframe
+ pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ button $mytoplevel.buttonframe.cancel -text [_ "Cancel"]\
+ -command "::dialog_audio::cancel $mytoplevel"
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 15
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"]\
+ -command "::dialog_audio::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 15
+ button $mytoplevel.buttonframe.ok -text [_ "OK"] \
+ -command "::dialog_audio::ok $mytoplevel"
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 15
+
+ button $mytoplevel.saveall -text [_ "Save All Settings"]\
+ -command "::dialog_audio::apply $mytoplevel; pdsend {pd save-preferences}"
+ pack $mytoplevel.saveall -side bottom -expand 1 -pady 5
# sample rate and advance
- frame $id.srf
- pack $id.srf -side top
+ frame $mytoplevel.srf
+ pack $mytoplevel.srf -side top
- label $id.srf.l1 -text [_ "Sample rate:"]
- entry $id.srf.x1 -textvariable audio_sr -width 7
- label $id.srf.l2 -text [_ "Delay (msec):"]
- entry $id.srf.x2 -textvariable audio_advance -width 4
- pack $id.srf.l1 $id.srf.x1 $id.srf.l2 $id.srf.x2 -side left
+ label $mytoplevel.srf.l1 -text [_ "Sample rate:"]
+ entry $mytoplevel.srf.x1 -textvariable audio_sr -width 7
+ label $mytoplevel.srf.l2 -text [_ "Delay (msec):"]
+ entry $mytoplevel.srf.x2 -textvariable audio_advance -width 4
+
+ label $mytoplevel.srf.l3 -text [_ "Block size:"]
+ tk_optionMenu $mytoplevel.srf.x3 audio_blocksize 64 128 256 512 1024 2048
+
+ pack $mytoplevel.srf.l1 $mytoplevel.srf.x1 $mytoplevel.srf.l2 \
+ $mytoplevel.srf.x2 $mytoplevel.srf.l3 $mytoplevel.srf.x3 -side left
if {$audio_callback >= 0} {
- checkbutton $id.srf.x3 -variable audio_callback \
+ checkbutton $mytoplevel.srf.x4 -variable audio_callback \
-text [_ "Use callbacks"] -anchor e
- pack $id.srf.x3 -side left
+ pack $mytoplevel.srf.x4 -side left
}
# input device 1
- frame $id.in1f
- pack $id.in1f -side top
+ frame $mytoplevel.in1f
+ pack $mytoplevel.in1f -side top
- checkbutton $id.in1f.x0 -variable audio_inenable1 \
+ checkbutton $mytoplevel.in1f.x0 -variable audio_inenable1 \
-text [_ "Input device 1:"] -anchor e
- button $id.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
- -command [list audio_popup $id $id.in1f.x1 audio_indev1 $audio_indevlist]
- label $id.in1f.l2 -text [_ "Channels:"]
- entry $id.in1f.x2 -textvariable audio_inchan1 -width 3
- pack $id.in1f.x0 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left -fill x
+ button $mytoplevel.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in1f.x1 audio_indev1 $audio_indevlist]
+ label $mytoplevel.in1f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in1f.x2 -textvariable audio_inchan1 -width 3
+ pack $mytoplevel.in1f.x0 $mytoplevel.in1f.x1 $mytoplevel.in1f.l2 \
+ $mytoplevel.in1f.x2 -side left -fill x
# input device 2
if {$longform && $multi > 1 && [llength $audio_indevlist] > 1} {
- frame $id.in2f
- pack $id.in2f -side top
+ frame $mytoplevel.in2f
+ pack $mytoplevel.in2f -side top
- checkbutton $id.in2f.x0 -variable audio_inenable2 \
+ checkbutton $mytoplevel.in2f.x0 -variable audio_inenable2 \
-text [_ "Input device 2:"] -anchor e
- button $id.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
- -command [list audio_popup $id $id.in2f.x1 audio_indev2 \
+ button $mytoplevel.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in2f.x1 audio_indev2 \
$audio_indevlist]
- label $id.in2f.l2 -text [_ "Channels:"]
- entry $id.in2f.x2 -textvariable audio_inchan2 -width 3
- pack $id.in2f.x0 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left -fill x
+ label $mytoplevel.in2f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in2f.x2 -textvariable audio_inchan2 -width 3
+ pack $mytoplevel.in2f.x0 $mytoplevel.in2f.x1 $mytoplevel.in2f.l2 \
+ $mytoplevel.in2f.x2 -side left -fill x
}
# input device 3
if {$longform && $multi > 1 && [llength $audio_indevlist] > 2} {
- frame $id.in3f
- pack $id.in3f -side top
+ frame $mytoplevel.in3f
+ pack $mytoplevel.in3f -side top
- checkbutton $id.in3f.x0 -variable audio_inenable3 \
+ checkbutton $mytoplevel.in3f.x0 -variable audio_inenable3 \
-text [_ "Input device 3:"] -anchor e
- button $id.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
- -command [list audio_popup $id $id.in3f.x1 audio_indev3 \
+ button $mytoplevel.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in3f.x1 audio_indev3 \
$audio_indevlist]
- label $id.in3f.l2 -text [_ "Channels:"]
- entry $id.in3f.x2 -textvariable audio_inchan3 -width 3
- pack $id.in3f.x0 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left
+ label $mytoplevel.in3f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in3f.x2 -textvariable audio_inchan3 -width 3
+ pack $mytoplevel.in3f.x0 $mytoplevel.in3f.x1 $mytoplevel.in3f.l2 $mytoplevel.in3f.x2 -side left
}
# input device 4
if {$longform && $multi > 1 && [llength $audio_indevlist] > 3} {
- frame $id.in4f
- pack $id.in4f -side top
+ frame $mytoplevel.in4f
+ pack $mytoplevel.in4f -side top
- checkbutton $id.in4f.x0 -variable audio_inenable4 \
+ checkbutton $mytoplevel.in4f.x0 -variable audio_inenable4 \
-text [_ "Input device 4:"] -anchor e
- button $id.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
- -command [list audio_popup $id $id.in4f.x1 audio_indev4 \
+ button $mytoplevel.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
+ -command [list audio_popup $mytoplevel $mytoplevel.in4f.x1 audio_indev4 \
$audio_indevlist]
- label $id.in4f.l2 -text [_ "Channels:"]
- entry $id.in4f.x2 -textvariable audio_inchan4 -width 3
- pack $id.in4f.x0 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left
+ label $mytoplevel.in4f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.in4f.x2 -textvariable audio_inchan4 -width 3
+ pack $mytoplevel.in4f.x0 $mytoplevel.in4f.x1 $mytoplevel.in4f.l2 \
+ $mytoplevel.in4f.x2 -side left
}
# output device 1
- frame $id.out1f
- pack $id.out1f -side top
+ frame $mytoplevel.out1f
+ pack $mytoplevel.out1f -side top
- checkbutton $id.out1f.x0 -variable audio_outenable1 \
+ checkbutton $mytoplevel.out1f.x0 -variable audio_outenable1 \
-text [_ "Output device 1:"] -anchor e
if {$multi == 0} {
- label $id.out1f.l1 \
+ label $mytoplevel.out1f.l1 \
-text [_ "(same as input device) .............. "]
} else {
- button $id.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
- -command [list audio_popup $id $id.out1f.x1 audio_outdev1 \
+ button $mytoplevel.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
+ -command [list audio_popup $mytoplevel $mytoplevel.out1f.x1 audio_outdev1 \
$audio_outdevlist]
}
- label $id.out1f.l2 -text [_ "Channels:"]
- entry $id.out1f.x2 -textvariable audio_outchan1 -width 3
+ label $mytoplevel.out1f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out1f.x2 -textvariable audio_outchan1 -width 3
if {$multi == 0} {
- pack $id.out1f.x0 $id.out1f.l1 $id.out1f.x2 -side left -fill x
+ pack $mytoplevel.out1f.x0 $mytoplevel.out1f.l1 $mytoplevel.out1f.x2 -side left -fill x
} else {
- pack $id.out1f.x0 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left -fill x
+ pack $mytoplevel.out1f.x0 $mytoplevel.out1f.x1 $mytoplevel.out1f.l2\
+ $mytoplevel.out1f.x2 -side left -fill x
}
# output device 2
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 1} {
- frame $id.out2f
- pack $id.out2f -side top
+ frame $mytoplevel.out2f
+ pack $mytoplevel.out2f -side top
- checkbutton $id.out2f.x0 -variable audio_outenable2 \
+ checkbutton $mytoplevel.out2f.x0 -variable audio_outenable2 \
-text [_ "Output device 2:"] -anchor e
- button $id.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
+ button $mytoplevel.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
-command \
- [list audio_popup $id $id.out2f.x1 audio_outdev2 $audio_outdevlist]
- label $id.out2f.l2 -text [_ "Channels:"]
- entry $id.out2f.x2 -textvariable audio_outchan2 -width 3
- pack $id.out2f.x0 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out2f.x1 audio_outdev2 $audio_outdevlist]
+ label $mytoplevel.out2f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out2f.x2 -textvariable audio_outchan2 -width 3
+ pack $mytoplevel.out2f.x0 $mytoplevel.out2f.x1 $mytoplevel.out2f.l2\
+ $mytoplevel.out2f.x2 -side left
}
# output device 3
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 2} {
- frame $id.out3f
- pack $id.out3f -side top
+ frame $mytoplevel.out3f
+ pack $mytoplevel.out3f -side top
- checkbutton $id.out3f.x0 -variable audio_outenable3 \
+ checkbutton $mytoplevel.out3f.x0 -variable audio_outenable3 \
-text [_ "Output device 3:"] -anchor e
- button $id.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
+ button $mytoplevel.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
-command \
- [list audio_popup $id $id.out3f.x1 audio_outdev3 $audio_outdevlist]
- label $id.out3f.l2 -text [_ "Channels:"]
- entry $id.out3f.x2 -textvariable audio_outchan3 -width 3
- pack $id.out3f.x0 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out3f.x1 audio_outdev3 $audio_outdevlist]
+ label $mytoplevel.out3f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out3f.x2 -textvariable audio_outchan3 -width 3
+ pack $mytoplevel.out3f.x0 $mytoplevel.out3f.x1 $mytoplevel.out3f.l2 \
+ $mytoplevel.out3f.x2 -side left
}
# output device 4
if {$longform && $multi > 1 && [llength $audio_outdevlist] > 3} {
- frame $id.out4f
- pack $id.out4f -side top
+ frame $mytoplevel.out4f
+ pack $mytoplevel.out4f -side top
- checkbutton $id.out4f.x0 -variable audio_outenable4 \
+ checkbutton $mytoplevel.out4f.x0 -variable audio_outenable4 \
-text [_ "Output device 4:"] -anchor e
- button $id.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
+ button $mytoplevel.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
-command \
- [list audio_popup $id $id.out4f.x1 audio_outdev4 $audio_outdevlist]
- label $id.out4f.l2 -text [_ "Channels:"]
- entry $id.out4f.x2 -textvariable audio_outchan4 -width 3
- pack $id.out4f.x0 $id.out4f.x1 $id.out4f.l2 $id.out4f.x2 -side left
+ [list audio_popup $mytoplevel $mytoplevel.out4f.x1 audio_outdev4 $audio_outdevlist]
+ label $mytoplevel.out4f.l2 -text [_ "Channels:"]
+ entry $mytoplevel.out4f.x2 -textvariable audio_outchan4 -width 3
+ pack $mytoplevel.out4f.x0 $mytoplevel.out4f.x1 $mytoplevel.out4f.l2 \
+ $mytoplevel.out4f.x2 -side left
}
# if not the "long form" but if "multi" is 2, make a button to
# restart with longform set.
if {$longform == 0 && $multi > 1} {
- frame $id.longbutton
- pack $id.longbutton -side top
- button $id.longbutton.b -text [_ "Use multiple devices"] \
+ frame $mytoplevel.longbutton
+ pack $mytoplevel.longbutton -side top
+ button $mytoplevel.longbutton.b -text [_ "Use multiple devices"] \
-command {pdsend "pd audio-properties 1"}
- pack $id.longbutton.b
+ pack $mytoplevel.longbutton.b
}
- $id.srf.x1 select from 0
- $id.srf.x1 select adjust end
- focus $id.srf.x1
+ $mytoplevel.srf.x1 select from 0
+ $mytoplevel.srf.x1 select adjust end
+ focus $mytoplevel.srf.x1
}
diff --git a/pd/tcl/dialog_canvas.tcl b/pd/tcl/dialog_canvas.tcl
index 06444807e..ea3f5d65a 100644
--- a/pd/tcl/dialog_canvas.tcl
+++ b/pd/tcl/dialog_canvas.tcl
@@ -104,7 +104,6 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
} else {
create_dialog $mytoplevel
}
- puts "canvas_dialog $mytoplevel"
switch -- $graphmeflags {
0 {
$mytoplevel.parent.graphme deselect
@@ -119,7 +118,7 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
$mytoplevel.parent.graphme select
$mytoplevel.parent.hidetext select
} default {
- pdtk_post "Warning: unknown graphme flags received in pdtk_canvas_dialog"
+ ::pdwindow::error [_ "WARNING: unknown graphme flags received in pdtk_canvas_dialog"]
}
}
@@ -131,8 +130,8 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
$mytoplevel.range.y.to_entry insert 0 $yto
$mytoplevel.range.x.size_entry insert 0 $xsize
$mytoplevel.range.y.size_entry insert 0 $ysize
- $mytoplevel.range.x.margin_entry insert 0 $xsize
- $mytoplevel.range.y.margin_entry insert 0 $ysize
+ $mytoplevel.range.x.margin_entry insert 0 $xmargin
+ $mytoplevel.range.y.margin_entry insert 0 $ymargin
::dialog_canvas::checkcommand $mytoplevel
}
@@ -140,7 +139,11 @@ proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags
proc ::dialog_canvas::create_dialog {mytoplevel} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Canvas Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "canvas"
labelframe $mytoplevel.scale -text [_ "Scale"] -borderwidth 1
@@ -201,13 +204,16 @@ proc ::dialog_canvas::create_dialog {mytoplevel} {
-side left
frame $mytoplevel.buttons
- pack $mytoplevel.buttons -side bottom -fill x -pady 2m
+ pack $mytoplevel.buttons -side bottom -fill x -expand 1 -pady 2m
button $mytoplevel.buttons.cancel -text [_ "Cancel"] \
-command "::dialog_canvas::cancel $mytoplevel"
- button $mytoplevel.buttons.apply -text [_ "Apply"] \
- -command "::dialog_canvas::apply $mytoplevel"
+ pack $mytoplevel.buttons.cancel -side left -expand 1 -fill x -padx 10
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttons.apply -text [_ "Apply"] \
+ -command "::dialog_canvas::apply $mytoplevel"
+ pack $mytoplevel.buttons.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttons.ok -text [_ "OK"] \
-command "::dialog_canvas::ok $mytoplevel"
- pack $mytoplevel.buttons.cancel $mytoplevel.buttons.apply \
- $mytoplevel.buttons.ok -side left -expand 1
+ pack $mytoplevel.buttons.ok -side left -expand 1 -fill x -padx 10
}
diff --git a/pd/tcl/dialog_data.tcl b/pd/tcl/dialog_data.tcl
new file mode 100644
index 000000000..0bc989f53
--- /dev/null
+++ b/pd/tcl/dialog_data.tcl
@@ -0,0 +1,53 @@
+
+package provide dialog_data 0.1
+
+namespace eval ::dialog_data:: {
+ namespace export pdtk_data_dialog
+}
+
+############ pdtk_data_dialog -- run a data dialog #########
+
+proc ::dialog_data::send {mytoplevel} {
+ for {set i 1} {[$mytoplevel.text compare [concat $i.0 + 3 chars] < end]} \
+ {incr i 1} {
+ pdsend "$mytoplevel data [$mytoplevel.text get $i.0 [expr $i + 1].0]"
+ }
+ pdsend "$mytoplevel end"
+}
+
+proc ::dialog_data::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+proc ::dialog_data::ok {mytoplevel} {
+ ::dialog_data::send $mytoplevel
+ ::dialog_data::cancel $mytoplevel
+}
+
+proc ::dialog_data::pdtk_data_dialog {mytoplevel stuff} {
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel [_ "Data Properties"]
+ wm group $mytoplevel $::focused_window
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
+
+ frame $mytoplevel.buttonframe
+ pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ button $mytoplevel.buttonframe.send -text [_ "Send (Ctrl s)"] \
+ -command "::dialog_data::send $mytoplevel"
+ button $mytoplevel.buttonframe.ok -text [_ "OK (Ctrl t)"] \
+ -command "::dialog_data::ok $mytoplevel"
+ pack $mytoplevel.buttonframe.send -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1
+
+ text $mytoplevel.text -relief raised -bd 2 -height 40 -width 60 \
+ -yscrollcommand "$mytoplevel.scroll set"
+ scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview"
+ pack $mytoplevel.scroll -side right -fill y
+ pack $mytoplevel.text -side left -fill both -expand 1
+ $mytoplevel.text insert end $stuff
+ focus $mytoplevel.text
+ bind $mytoplevel.text <Control-t> "::dialog_data::ok $mytoplevel"
+ bind $mytoplevel.text <Control-s> "::dialog_data::send $mytoplevel"
+}
diff --git a/pd/tcl/dialog_find.tcl b/pd/tcl/dialog_find.tcl
index c7a708ae5..443bec3a8 100644
--- a/pd/tcl/dialog_find.tcl
+++ b/pd/tcl/dialog_find.tcl
@@ -1,117 +1,182 @@
+# the find dialog panel is a bit unusual in that it is created directly by the
+# Tcl 'pd-gui'. Most dialog panels are created by sending a message to 'pd',
+# which then sends a message to 'pd-gui' to create the panel.
package provide dialog_find 0.1
package require pd_bindings
namespace eval ::dialog_find:: {
+ variable find_in_toplevel ".pdwindow"
# store the state of the "Match whole word only" check box
variable wholeword_button 0
# if the search hasn't changed, then the Find button sends "findagain"
variable previous_wholeword_button 0
variable previous_findstring ""
+ variable find_history {}
+ variable history_position 0
- namespace export menu_dialog_find
+ namespace export pdtk_couldnotfind
}
-# TODO make find panel as small as possible, being topmost means its findable
-# TODO (GNOME/Windows) find panel should retain focus after a find
-# TODO (Mac OS X) hide panel after success, but stay if the find was unsuccessful
+proc ::dialog_find::get_history {direction} {
+ variable find_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $find_history]} {
+ set history_position [llength $find_history]
+ }
+ .find.entry delete 0 end
+ .find.entry insert 0 [lindex $find_history end-[expr $history_position - 1]]
+}
+# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
proc ::dialog_find::ok {mytoplevel} {
+ variable find_in_window
variable wholeword_button
variable previous_wholeword_button
variable previous_findstring
- # find will be on top, so use the previous window that was on top
- set search_window [lindex [wm stackorder .] end-1]
- puts "search_window $search_window"
+ variable find_history
+
set findstring [.find.entry get]
- if {$findstring eq ""} {return}
- if {$search_window eq ".pdwindow"} {
- set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
+ if {$findstring eq ""} {
+ if {$::windowingsystem eq "aqua"} {bell}
+ return
+ }
+ if {$find_in_window eq ".pdwindow"} {
+ if {$::tcl_version < 8.5} {
+ # TODO implement in 8.4 style, without -all
+ set matches [.pdwindow.text search -nocase -- $findstring 0.0]
+ } else {
+ set matches [.pdwindow.text search -all -nocase -- $findstring 0.0]
+ }
.pdwindow.text tag delete sel
- foreach match $matches {
- .pdwindow.text tag add sel $match "$match wordend"
+ if {[llength $matches] > 0} {
+ foreach match $matches {
+ .pdwindow.text tag add sel $match "$match wordend"
+ }
+ .pdwindow.text see [lindex $matches 0]
+ lappend find_history $findstring
}
- .pdwindow.text see [lindex $matches 0]
} else {
if {$findstring eq $previous_findstring \
&& $wholeword_button == $previous_wholeword_button} {
- pdsend "$search_window findagain"
+ pdsend "$find_in_window findagain"
} else {
- # TODO switch back to this for 0.43:
- #pdsend "$search_window find $findstring $wholeword_button"
- pdsend "$search_window find $findstring"
+ pdsend [concat $find_in_window find [pdtk_encodedialog $findstring] \
+ $wholeword_button]
set previous_findstring $findstring
set previous_wholeword_button $wholeword_button
+ lappend find_history $findstring
}
}
+ if {$::windowingsystem eq "aqua"} {
+ # (Mac OS X) hide panel after success, but keep it if unsuccessful by
+ # having the couldnotfind proc reopen it
+ cancel $mytoplevel
+ } else {
+ # (GNOME/Windows) find panel should retain focus after a find
+ # (yes, a bit of a kludge)
+ after 100 "raise .find; focus .find.entry"
+ }
}
+# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
proc ::dialog_find::cancel {mytoplevel} {
wm withdraw .find
}
-proc ::dialog_find::set_canvas_to_search {mytoplevel} {
- # TODO rewrite using global $::focused_window
+proc ::dialog_find::set_window_to_search {mytoplevel} {
+ variable find_in_window $mytoplevel
if {[winfo exists .find.frame.targetlabel]} {
- set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end]]
- if {$focusedtoplevel eq ".find"} {
- set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end-1]]
+ if {$find_in_window eq ".find"} {
+ set find_in_window [winfo toplevel [lindex [wm stackorder .] end-1]]
}
- if {$focusedtoplevel eq ".pdwindow"} {
- .find.frame.targetlabel configure -text [wm title .pdwindow]
- } else {
- foreach window $::menu_windowlist {
- if {[lindex $window 1] eq $focusedtoplevel} {
- .find.frame.targetlabel configure -text [lindex $window 0]
- }
- }
+ # this has funny side effects in tcl 8.4 ???
+ if {$::tcl_version >= 8.5} {
+ wm transient .find $find_in_window
}
+ .find.frame.targetlabel configure -text \
+ [lookup_windowname $find_in_window]
}
}
+proc ::dialog_find::pdtk_couldnotfind {mytoplevel} {
+ bell
+ ::pdwindow::error [format [_ "Couldn't find '%s' in %s"] \
+ [.find.entry get] [lookup_windowname $mytoplevel] ]
+ if {$::windowingsystem eq "aqua"} {open_find_dialog $mytoplevel}
+}
+
# the find panel is opened from the menu and key bindings
-proc ::dialog_find::menu_find_dialog {mytoplevel} {
+proc ::dialog_find::open_find_dialog {mytoplevel} {
if {[winfo exists .find]} {
wm deiconify .find
raise .find
} else {
create_dialog $mytoplevel
}
+ .find.entry selection range 0 end
}
proc ::dialog_find::create_dialog {mytoplevel} {
toplevel .find -class DialogWindow
wm title .find [_ "Find"]
wm geometry .find =475x125+150+150
- .find configure
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group .find .
+ wm resizable .find 0 0
+ wm transient .find
+ .find configure -menu $::dialog_menubar
+ .find configure -padx 10 -pady 5
::pd_bindings::dialog_bindings .find "find"
+ # sending these commands to the Find Dialog Panel should forward them to
+ # the currently focused patch
+ bind .find <$::modifier-Key-s> \
+ {menu_send $::focused_window menusave; break}
+ bind .find <$::modifier-Shift-Key-S> \
+ {menu_send $::focused_window menusaveas; break}
+ bind .find <$::modifier-Key-p> \
+ {menu_print $::focused_window; break}
frame .find.frame
pack .find.frame -side top -fill x -pady 1
label .find.frame.searchin -text [_ "Search in"]
- label .find.frame.targetlabel -font "TkTextFont 14"
+ label .find.frame.targetlabel -text [_ "Pd window"]
label .find.frame.for -text [_ "for:"]
pack .find.frame.searchin .find.frame.targetlabel .find.frame.for -side left
entry .find.entry -width 54 -font 18 -relief sunken \
- -highlightthickness 3 -highlightcolor blue
- focus .find.entry
+ -highlightthickness 1 -highlightcolor blue
pack .find.entry -side top -padx 10
+
+ bind .find.entry <Up> "::dialog_find::get_history 1"
+ bind .find.entry <Down> "::dialog_find::get_history -1"
checkbutton .find.wholeword -variable ::dialog_find::wholeword_button \
-text [_ "Match whole word only"] -anchor w
pack .find.wholeword -side top -padx 30 -pady 3 -fill x
frame .find.buttonframe -background yellow
+ pack .find.buttonframe -side right -pady 3
+ if {$::windowingsystem eq "win32"} {
+ button .find.cancel -text [_ "Cancel"] -default normal -width 9 \
+ -command "::dialog_find::cancel $mytoplevel"
+ pack .find.cancel -side right -padx 6 -pady 3
+ }
button .find.button -text [_ "Find"] -default active -width 9 \
-command "::dialog_find::ok $mytoplevel"
+ pack .find.button -side right -padx 6 -pady 3
if {$::windowingsystem eq "x11"} {
button .find.close -text [_ "Close"] -default normal -width 9 \
-command "::dialog_find::cancel $mytoplevel"
- pack .find.buttonframe .find.button .find.close -side right -padx 10 -pady 3
- } else {
- pack .find.buttonframe .find.button -side right -padx 10 -pady 3
+ pack .find.close -side right -padx 6 -pady 3
}
- ::dialog_find::set_canvas_to_search $mytoplevel
+ # on Mac OS X, the buttons shouldn't get Tab/keyboard focus
+ if {$::windowingsystem eq "aqua"} {
+ .find.wholeword configure -takefocus 0
+ .find.button configure -takefocus 0
+ }
+ ::dialog_find::set_window_to_search $mytoplevel
+ focus .find.entry
}
diff --git a/pd/tcl/dialog_font.tcl b/pd/tcl/dialog_font.tcl
index 578d155ea..fce160003 100644
--- a/pd/tcl/dialog_font.tcl
+++ b/pd/tcl/dialog_font.tcl
@@ -7,17 +7,17 @@ namespace eval ::dialog_font:: {
variable whichstretch 1
variable canvaswindow
variable sizes {8 10 12 16 24 36}
- variable gfxstub
namespace export pdtk_canvas_dofont
}
# TODO this should use the pd_font_$size fonts created in pd-gui.tcl
+# TODO change pdtk_canvas_dofont to pdtk_font_dialog here and g_editor.c
# TODO this should really be changed on the C side so that it doesn't have to
# work around gfxstub/x_gui.c. The gfxstub stuff assumes that there are
# multiple panels, for properties panels like this, its much easier to use if
-# there is a single properties panel that adjusts based on which CanvasWindow
+# there is a single properties panel that adjusts based on which PatchWindow
# has focus
proc ::dialog_font::apply {mytoplevel myfontsize} {
@@ -30,44 +30,41 @@ proc ::dialog_font::apply {mytoplevel myfontsize} {
}
}
-proc ::dialog_font::cancel {mygfxstub} {
- if {$mygfxstub ne ".pdwindow"} {
- pdsend "$mygfxstub cancel"
+proc ::dialog_font::cancel {gfxstub} {
+ if {$gfxstub ne ".pdwindow"} {
+ pdsend "$gfxstub cancel"
}
destroy .font
}
-proc ::dialog_font::ok {mygfxstub} {
+proc ::dialog_font::ok {gfxstub} {
variable fontsize
- ::dialog_font::apply $mygfxstub $fontsize
- ::dialog_font::cancel $mygfxstub
+ apply $gfxstub $fontsize
+ cancel $gfxstub
}
proc ::dialog_font::update_font_dialog {mytoplevel} {
- set ::dialog_font::canvaswindow $mytoplevel
- if {$mytoplevel eq ".pdwindow"} {
- set windowname [_ "Pd window"]
- } else {
- set windowname [lookup_windowname $mytoplevel]
- }
+ variable canvaswindow $mytoplevel
if {[winfo exists .font]} {
- wm title .font [format [_ "%s Font"] $windowname]
+ wm title .font [format [_ "%s Font"] [lookup_windowname $mytoplevel]]
}
}
proc ::dialog_font::arrow_fontchange {change} {
variable sizes
- set position [expr [lsearch $sizes $::dialog_font::fontsize] + $change]
+ variable fontsize
+ variable canvaswindow
+ set position [expr [lsearch $sizes $fontsize] + $change]
if {$position < 0} {set position 0}
set max [llength $sizes]
if {$position >= $max} {set position [expr $max-1]}
- set ::dialog_font::fontsize [lindex $sizes $position]
- ::dialog_font::apply $::dialog_font::canvaswindow $::dialog_font::fontsize
+ set fontsize [lindex $sizes $position]
+ ::dialog_font::apply $canvaswindow $fontsize
}
# this should be called pdtk_font_dialog like the rest of the panels, but it
# is called from the C side, so we'll leave it be
-proc ::dialog_font::pdtk_canvas_dofont {mygfxstub initsize} {
+proc ::dialog_font::pdtk_canvas_dofont {gfxstub initsize} {
variable fontsize $initsize
variable whichstretch 1
variable stretchval 100
@@ -77,28 +74,34 @@ proc ::dialog_font::pdtk_canvas_dofont {mygfxstub initsize} {
# the gfxstub stuff expects multiple font windows, we only have one,
# so kill the new gfxstub requests as the come in. We'll save the
# original gfxstub for when the font panel gets closed
- pdsend "$mygfxstub cancel"
+ pdsend "$gfxstub cancel"
} else {
- create_dialog $mygfxstub
+ create_dialog $gfxstub
}
}
-proc ::dialog_font::create_dialog {mygfxstub} {
- variable gfxstub $mygfxstub
+proc ::dialog_font::create_dialog {gfxstub} {
toplevel .font -class DialogWindow
- if {$::windowingsystem eq "aqua"} {.font configure -menu .menubar}
+ .font configure -menu $::dialog_menubar
+ .font configure -padx 10 -pady 5
+ wm group .font .
+ wm resizable .font 0 0
+ wm transient .font $::focused_window
::pd_bindings::dialog_bindings .font "font"
- # replace standard bindings to work around the gfxstub stuff
- bind .font <KeyPress-Escape> "::dialog_font::cancel $mygfxstub"
- bind .font <KeyPress-Return> "::dialog_font::ok $mygfxstub"
- bind .font <$::pd_bindings::modifier-Key-w> "::dialog_font::cancel $mygfxstub"
+ # replace standard bindings to work around the gfxstub stuff and use
+ # break to prevent the close window command from going to other bindings.
+ # .font won't exist anymore, so it'll cause errors down the line...
+ bind .font <KeyPress-Return> "::dialog_font::ok $gfxstub; break"
+ bind .font <KeyPress-Escape> "::dialog_font::cancel $gfxstub; break"
+ bind .font <$::modifier-Key-w> "::dialog_font::cancel $gfxstub; break"
+ wm protocol .font WM_DELETE_WINDOW "dialog_font::cancel $gfxstub"
bind .font <Up> "::dialog_font::arrow_fontchange -1"
bind .font <Down> "::dialog_font::arrow_fontchange 1"
frame .font.buttonframe
pack .font.buttonframe -side bottom -fill x -pady 2m
button .font.buttonframe.ok -text [_ "OK"] \
- -command "::dialog_font::ok $mygfxstub"
+ -command "::dialog_font::ok $gfxstub"
pack .font.buttonframe.ok -side left -expand 1
labelframe .font.fontsize -text [_ "Font Size"] -padx 5 -pady 4 -borderwidth 1 \
diff --git a/pd/tcl/dialog_gatom.tcl b/pd/tcl/dialog_gatom.tcl
index b59751bfb..3b30a1a9e 100644
--- a/pd/tcl/dialog_gatom.tcl
+++ b/pd/tcl/dialog_gatom.tcl
@@ -39,13 +39,13 @@ proc ::dialog_gatom::apply {mytoplevel} {
global gatomlabel_radio
pdsend "$mytoplevel param \
- [$mytoplevel.width.entry get] \
- [$mytoplevel.limits.lower.entry get] \
- [$mytoplevel.limits.upper.entry get] \
- [::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \
- $gatomlabel_radio($mytoplevel) \
- [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]] \
- [::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]]"
+ [$mytoplevel.width.entry get] \
+ [$mytoplevel.limits.lower.entry get] \
+ [$mytoplevel.limits.upper.entry get] \
+ [::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \
+ $gatomlabel_radio($mytoplevel) \
+ [::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]] \
+ [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]]"
}
proc ::dialog_gatom::cancel {mytoplevel} {
@@ -60,7 +60,7 @@ proc ::dialog_gatom::ok {mytoplevel} {
# set up the panel with the info from pd
proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower initupper \
initgatomlabel_radio \
- initgatomlabel initsend initreceive} {
+ initgatomlabel initreceive initsend} {
global gatomlabel_radio
set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
@@ -75,14 +75,17 @@ proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower initupper
$mytoplevel.limits.lower.entry insert 0 $initlower
$mytoplevel.limits.upper.entry insert 0 $initupper
if {$initgatomlabel ne "-"} {
- $mytoplevel.gatomlabel.name.entry insert 0 $initgatomlabel
+ $mytoplevel.gatomlabel.name.entry insert 0 \
+ [::dialog_gatom::unescape $initgatomlabel]
}
set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
if {$initsend ne "-"} {
- $mytoplevel.s_r.send.entry insert 0 $initsend
+ $mytoplevel.s_r.send.entry insert 0 \
+ [::dialog_gatom::unescape $initsend]
}
if {$initreceive ne "-"} {
- $mytoplevel.s_r.receive.entry insert 0 $initreceive
+ $mytoplevel.s_r.receive.entry insert 0 \
+ [::dialog_gatom::unescape $initreceive]
}
}
@@ -91,7 +94,11 @@ proc ::dialog_gatom::create_dialog {mytoplevel} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Atom Box Properties"]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "gatom"
frame $mytoplevel.width -height 7
@@ -149,16 +156,18 @@ proc ::dialog_gatom::create_dialog {mytoplevel} {
pack $mytoplevel.s_r.receive.entry $mytoplevel.s_r.receive.label -side right
frame $mytoplevel.buttonframe -pady 5
- pack $mytoplevel.buttonframe -side top -fill x -pady 2m
+ pack $mytoplevel.buttonframe -side top -fill x -expand 1 -pady 2m
button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
-command "::dialog_gatom::cancel $mytoplevel"
- pack $mytoplevel.buttonframe.cancel -side left -expand 1
- button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
- -command "::dialog_gatom::apply $mytoplevel"
- pack $mytoplevel.buttonframe.apply -side left -expand 1
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1 -fill x -padx 10
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.buttonframe.apply -text [_ "Apply"] \
+ -command "::dialog_gatom::apply $mytoplevel"
+ pack $mytoplevel.buttonframe.apply -side left -expand 1 -fill x -padx 10
+ }
button $mytoplevel.buttonframe.ok -text [_ "OK"] \
-command "::dialog_gatom::ok $mytoplevel"
- pack $mytoplevel.buttonframe.ok -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1 -fill x -padx 10
$mytoplevel.width.entry select from 0
$mytoplevel.width.entry select adjust end
diff --git a/pd/tcl/dialog_iemgui.tcl b/pd/tcl/dialog_iemgui.tcl
index 34ed4ccb4..5ad6cad58 100644
--- a/pd/tcl/dialog_iemgui.tcl
+++ b/pd/tcl/dialog_iemgui.tcl
@@ -73,7 +73,7 @@ proc ::dialog_iemgui::sched_rng {mytoplevel} {
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
$mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng }
if {[eval concat $$var_iemgui_max_rng] < $define_min_flashhold} {
- set $var_iemgui_max_rng $iemgui_define_min_flashhold
+ set $var_iemgui_max_rng $define_min_flashhold
$mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
}
if {[eval concat $$var_iemgui_min_rng] < $define_min_flashbreak} {
@@ -252,7 +252,7 @@ proc ::dialog_iemgui::toggle_font {mytoplevel gn_f} {
1 { set current_font "Helvetica" }
2 { set current_font "Times" }
}
- set current_font_spec "{$current_font} 12 $::font_weight"
+ set current_font_spec "{$current_font} 16 $::font_weight"
$mytoplevel.label.fontpopup_label configure -text $current_font \
-font $current_font_spec
@@ -362,7 +362,11 @@ proc ::dialog_iemgui::apply {mytoplevel} {
set hhhsnd [unspace_text $hhhsnd]
set hhhrcv [unspace_text $hhhrcv]
set hhhgui_nam [unspace_text $hhhgui_nam]
-
+
+# make sure the offset boxes have a value
+ if {[eval concat $$var_iemgui_gn_dx] eq ""} {set $var_iemgui_gn_dx 0}
+ if {[eval concat $$var_iemgui_gn_dy] eq ""} {set $var_iemgui_gn_dy 0}
+
pdsend [concat $mytoplevel dialog \
[eval concat $$var_iemgui_wdt] \
[eval concat $$var_iemgui_hgt] \
@@ -496,12 +500,16 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [format [_ "%s Properties"] $mainheader]
- if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
+ wm group $mytoplevel .
+ wm resizable $mytoplevel 0 0
+ wm transient $mytoplevel $::focused_window
+ $mytoplevel configure -menu $::dialog_menubar
+ $mytoplevel configure -padx 0 -pady 0
::pd_bindings::dialog_bindings $mytoplevel "iemgui"
frame $mytoplevel.dim
pack $mytoplevel.dim -side top
- label $mytoplevel.dim.head -text $dim_header
+ label $mytoplevel.dim.head -text [_ $dim_header]
label $mytoplevel.dim.w_lab -text [_ $wdt_label] -width 6
entry $mytoplevel.dim.w_ent -textvariable $var_iemgui_wdt -width 5
label $mytoplevel.dim.dummy1 -text " " -width 10
@@ -514,7 +522,7 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.rng
pack $mytoplevel.rng -side top
- label $mytoplevel.rng.head -text $rng_header
+ label $mytoplevel.rng.head -text [_ $rng_header]
label $mytoplevel.rng.min_lab -text [_ $min_rng_label] -width 6
entry $mytoplevel.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
label $mytoplevel.rng.dummy1 -text " " -width 1
@@ -544,21 +552,19 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
-command "::dialog_iemgui::lilo $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 0} {
button $mytoplevel.para.lb -text [_ "No init"] \
- -width [::msgcat::mcmax "No init"] \
-command "::dialog_iemgui::lb $mytoplevel" }
if {[eval concat $$var_iemgui_loadbang] == 1} {
button $mytoplevel.para.lb -text [_ "Save"] \
- -width [::msgcat::mcmax "Save"] \
-command "::dialog_iemgui::lb $mytoplevel" }
label $mytoplevel.para.num_lab -text [_ $num_label] -width 9
entry $mytoplevel.para.num_ent -textvariable $var_iemgui_num -width 4
if {[eval concat $$var_iemgui_steady] == 0} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
- -text [_ "Jump on click"] -width [::msgcat::mcmax "Jump on click"] }
+ -text [_ "Jump on click"] }
if {[eval concat $$var_iemgui_steady] == 1} {
button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
- -text [_ "Steady on click"] -width [::msgcat::mcmax "Steady on click"] }
+ -text [_ "Steady on click"] }
if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
pack $mytoplevel.para.lilo -side left -expand 1}
if {[eval concat $$var_iemgui_loadbang] >= 0} {
@@ -574,18 +580,22 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
labelframe $mytoplevel.s_r -borderwidth 1 -pady 4 -text [_ "Messages"]
pack $mytoplevel.s_r -side top -fill x -ipadx 5
frame $mytoplevel.s_r.send
- pack $mytoplevel.s_r.send -side top
- label $mytoplevel.s_r.send.lab -text [_ "Send symbol:"] -width 12 -justify right
+ pack $mytoplevel.s_r.send -side top -padx 4 -fill x -expand 1
+ label $mytoplevel.s_r.send.lab -text [_ "Send symbol:"] -justify left
entry $mytoplevel.s_r.send.ent -textvariable $var_iemgui_snd -width 22
if { $snd ne "nosndno" } {
- pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left}
+ pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left \
+ -fill x -expand 1
+ }
frame $mytoplevel.s_r.receive
- pack $mytoplevel.s_r.receive -side top
- label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol:"] -width 12 -justify right
+ pack $mytoplevel.s_r.receive -side top -padx 4 -fill x -expand 1
+ label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol:"] -justify left
entry $mytoplevel.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
if { $rcv ne "norcvno" } {
- pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left}
+ pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left \
+ -fill x -expand 1
+ }
# get the current font name from the int given from C-space (gn_f)
set current_font $::font_family
@@ -599,42 +609,40 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
labelframe $mytoplevel.label -borderwidth 1 -text [_ "Label"] -pady 4
pack $mytoplevel.label -side top -fill x
- entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \
- -font [list $current_font 12 $::font_weight]
+ entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam \
+ -width 30 -font [list $current_font 12 $::font_weight]
pack $mytoplevel.label.name_entry -side top -expand yes -fill both -padx 5
frame $mytoplevel.label.xy -padx 27 -pady 1
pack $mytoplevel.label.xy -side top
- label $mytoplevel.label.xy.x_lab -text [_ "X offset"] \
- -width [::msgcat::mcmax "X offset"]
+ label $mytoplevel.label.xy.x_lab -text [_ "X offset"]
entry $mytoplevel.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
label $mytoplevel.label.xy.dummy1 -text " " -width 2
- label $mytoplevel.label.xy.y_lab -text [_ "Y offset"] \
- -width [::msgcat::mcmax "Y offset"]
+ label $mytoplevel.label.xy.y_lab -text [_ "Y offset"]
entry $mytoplevel.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
pack $mytoplevel.label.xy.x_lab $mytoplevel.label.xy.x_entry $mytoplevel.label.xy.dummy1 \
$mytoplevel.label.xy.y_lab $mytoplevel.label.xy.y_entry -side left -anchor e
- label $mytoplevel.label.fontpopup_label -text $current_font \
- -relief groove -font [list $current_font 12 $::font_weight] -padx 5
- pack $mytoplevel.label.fontpopup_label -side left -anchor w -expand yes -fill x
- label $mytoplevel.label.fontsize_label -text [_ "Size:"] \
- -width [::msgcat::mcmax "Size:"]
+ button $mytoplevel.label.fontpopup_label -text $current_font \
+ -font [list $current_font 16 $::font_weight]
+ pack $mytoplevel.label.fontpopup_label -side left -anchor w \
+ -expand 1 -fill x -padx 5
+ label $mytoplevel.label.fontsize_label -text [_ "Size:"]
entry $mytoplevel.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
pack $mytoplevel.label.fontsize_entry $mytoplevel.label.fontsize_label \
-side right -anchor e -padx 5 -pady 5
menu $mytoplevel.popup
$mytoplevel.popup add command \
-label $::font_family \
- -font [format {{%s} 12 %s} $::font_family $::font_weight] \
+ -font [format {{%s} 16 %s} $::font_family $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 0"
$mytoplevel.popup add command \
-label "Helvetica" \
- -font [format {Helvetica 12 %s} $::font_weight] \
+ -font [format {Helvetica 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 1"
$mytoplevel.popup add command \
-label "Times" \
- -font [format {Times 12 %s} $::font_weight] \
+ -font [format {Times 16 %s} $::font_weight] \
-command "::dialog_iemgui::toggle_font $mytoplevel 2"
bind $mytoplevel.label.fontpopup_label <Button> \
[list tk_popup $mytoplevel.popup %X %Y]
@@ -648,14 +656,11 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.colors.select
pack $mytoplevel.colors.select -side top
radiobutton $mytoplevel.colors.select.radio0 -value 0 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Background"] -justify left \
- -width [::msgcat::mcmax "Background"]
+ $var_iemgui_l2_f1_b0 -text [_ "Background"] -justify left
radiobutton $mytoplevel.colors.select.radio1 -value 1 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Front"] -justify left \
- -width [::msgcat::mcmax "Front"]
+ $var_iemgui_l2_f1_b0 -text [_ "Front"] -justify left
radiobutton $mytoplevel.colors.select.radio2 -value 2 -variable \
- $var_iemgui_l2_f1_b0 -text [_ "Label"] -justify left \
- -width [::msgcat::mcmax "Label"]
+ $var_iemgui_l2_f1_b0 -text [_ "Label"] -justify left
if { [eval concat $$var_iemgui_fcol] >= 0 } {
pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio1 \
$mytoplevel.colors.select.radio2 -side left
@@ -666,7 +671,6 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
frame $mytoplevel.colors.sections
pack $mytoplevel.colors.sections -side top
button $mytoplevel.colors.sections.but -text [_ "Compose color"] \
- -width [::msgcat::mcmax "Compose color"] \
-command "::dialog_iemgui::choose_col_bkfrlb $mytoplevel"
pack $mytoplevel.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
-expand yes -fill x
@@ -686,7 +690,6 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
-font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
}
label $mytoplevel.colors.sections.lb_bk -text [_ "Test label"] \
- -width [::msgcat::mcmax "Test label"] \
-background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
-foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
@@ -744,26 +747,18 @@ proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
$mytoplevel.colors.r3.c8 $mytoplevel.colors.r3.c9 -side left
frame $mytoplevel.cao -pady 10
- pack $mytoplevel.cao -side top
- button $mytoplevel.cao.cancel -text [_ "Cancel"] -width 6 \
+ pack $mytoplevel.cao -side top -expand 1 -fill x
+ button $mytoplevel.cao.cancel -text [_ "Cancel"] \
-command "::dialog_iemgui::cancel $mytoplevel"
- label $mytoplevel.cao.dummy1 -text "" -width 3
- button $mytoplevel.cao.apply -text [_ "Apply"] -width 6 \
- -command "::dialog_iemgui::apply $mytoplevel"
- label $mytoplevel.cao.dummy2 -text "" -width 3
- button $mytoplevel.cao.ok -text [_ "OK"] -width 6 \
- -command "::dialog_iemgui::ok $mytoplevel"
- pack $mytoplevel.cao.cancel $mytoplevel.cao.dummy1 -side left
- pack $mytoplevel.cao.apply $mytoplevel.cao.dummy2 -side left
- pack $mytoplevel.cao.ok -side left
-
- if {[info tclversion] < 8.4} {
- bind $mytoplevel <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
- bind $mytoplevel <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
- } else {
- bind $mytoplevel <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
- bind $mytoplevel <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+ pack $mytoplevel.cao.cancel -side left -padx 10 -expand 1 -fill x
+ if {$::windowingsystem ne "aqua"} {
+ button $mytoplevel.cao.apply -text [_ "Apply"] \
+ -command "::dialog_iemgui::apply $mytoplevel"
+ pack $mytoplevel.cao.apply -side left -padx 10 -expand 1 -fill x
}
+ button $mytoplevel.cao.ok -text [_ "OK"] \
+ -command "::dialog_iemgui::ok $mytoplevel"
+ pack $mytoplevel.cao.ok -side left -padx 10 -expand 1 -fill x
$mytoplevel.dim.w_ent select from 0
$mytoplevel.dim.w_ent select adjust end
diff --git a/pd/tcl/dialog_message.tcl b/pd/tcl/dialog_message.tcl
new file mode 100644
index 000000000..107f1095c
--- /dev/null
+++ b/pd/tcl/dialog_message.tcl
@@ -0,0 +1,85 @@
+# the message dialog panel is a bit unusual in that it is created directly by
+# the Tcl 'pd-gui'. Most dialog panels are created by sending a message to
+# 'pd', which then sends a message to 'pd-gui' to create the panel. This is
+# similar to the Find dialog panel.
+
+package provide dialog_message 0.1
+
+package require pd_bindings
+
+namespace eval ::dialog_message:: {
+ variable message_history {"pd dsp 1"}
+ variable history_position 0
+
+ namespace export open_message_dialog
+}
+
+proc ::dialog_message::get_history {direction} {
+ variable message_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $message_history]} {
+ set history_position [llength $message_history]
+ }
+ .message.f.entry delete 0 end
+ .message.f.entry insert 0 \
+ [lindex $message_history end-[expr $history_position - 1]]
+}
+
+# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
+proc ::dialog_message::ok {mytoplevel} {
+ variable message_history
+ set message [.message.f.entry get]
+ if {$message ne ""} {
+ pdsend $message
+ lappend message_history $message
+ .message.f.entry delete 0 end
+ }
+}
+
+# mytoplevel isn't used here, but is kept for compatibility with other dialog cancel procs
+proc ::dialog_message::cancel {mytoplevel} {
+ wm withdraw .message
+}
+
+# the message panel is opened from the menu and key bindings
+proc ::dialog_message::open_message_dialog {mytoplevel} {
+ if {[winfo exists .message]} {
+ wm deiconify .message
+ raise .message
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_message::create_dialog {mytoplevel} {
+ toplevel .message -class DialogWindow
+ wm group .message .
+ wm transient .message
+ wm title .message [_ "Send a Pd message"]
+ wm geometry .message =400x80+150+150
+ wm resizable .message 1 0
+ wm minsize .message 250 80
+ .message configure -menu $::dialog_menubar
+ .message configure -padx 10 -pady 5
+ ::pd_bindings::dialog_bindings .message "message"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $id -topmost 1}
+
+ # TODO this should use something like 'dialogfont' for the font
+ frame .message.f
+ pack .message.f -side top -fill x -expand 1
+ entry .message.f.entry -width 54 -font {Helvetica 18} -relief sunken \
+ -highlightthickness 1 -highlightcolor blue
+ label .message.f.semicolon -text ";" -font {Helvetica 24}
+ pack .message.f.semicolon -side left
+ pack .message.f.entry -side left -padx 10 -fill x -expand 1
+ focus .message.f.entry
+ label .message.label -text [_ "(use arrow keys for history)"]
+ pack .message.label -side bottom
+
+ bind .message.f.entry <Up> "::dialog_message::get_history 1"
+ bind .message.f.entry <Down> "::dialog_message::get_history -1"
+}
diff --git a/pd/tcl/dialog_midi.tcl b/pd/tcl/dialog_midi.tcl
index d85546657..450d29388 100644
--- a/pd/tcl/dialog_midi.tcl
+++ b/pd/tcl/dialog_midi.tcl
@@ -2,6 +2,7 @@ package provide dialog_midi 0.1
namespace eval ::dialog_midi:: {
namespace export pdtk_midi_dialog
+ namespace export pdtk_alsa_midi_dialog
}
# TODO this panel really needs some reworking, it works but the code is
@@ -81,10 +82,16 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
set midi_alsain [llength $midi_indevlist]
set midi_alsaout [llength $midi_outdevlist]
- toplevel $id
+ toplevel $id -class DialogWindow
wm title $id [_ "MIDI Settings"]
- if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
+ wm group $id .
+ wm resizable $id 0 0
+ wm transient $id
+ $id configure -menu $::dialog_menubar
+ $id configure -padx 10 -pady 5
::pd_bindings::dialog_bindings $id "midi"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $id -topmost 1}
frame $id.buttonframe
pack $id.buttonframe -side bottom -fill x -pady 2m
@@ -165,7 +172,7 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
}
# output device 3
- if {$longform && [llength $midi_midi_outdevlist] > 3} {
+ if {$longform && [llength $midi_outdevlist] > 3} {
frame $id.out3f
pack $id.out3f -side top
label $id.out3f.l1 -text [_ "Output device 3:"]
@@ -176,7 +183,7 @@ proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
}
# output device 4
- if {$longform && [llength $midi_midi_outdevlist] > 4} {
+ if {$longform && [llength $midi_outdevlist] > 4} {
frame $id.out4f
pack $id.out4f -side top
label $id.out4f.l1 -text [_ "Output device 4:"]
diff --git a/pd/tcl/dialog_path.tcl b/pd/tcl/dialog_path.tcl
new file mode 100644
index 000000000..40a306bae
--- /dev/null
+++ b/pd/tcl/dialog_path.tcl
@@ -0,0 +1,70 @@
+
+package provide dialog_path 0.1
+
+namespace eval ::dialog_path:: {
+ variable use_standard_extensions_button 1
+ variable verbose_button 0
+
+ namespace export pdtk_path_dialog
+}
+
+############ pdtk_path_dialog -- run a path dialog #########
+
+# set up the panel with the info from pd
+proc ::dialog_path::pdtk_path_dialog {mytoplevel extrapath verbose} {
+ global use_standard_extensions_button
+ global verbose_button
+ set use_standard_extensions_button $extrapath
+ set verbose_button $verbose
+
+ if {[winfo exists $mytoplevel]} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_path::create_dialog {mytoplevel} {
+
+ scrollboxwindow::make $mytoplevel $::sys_searchpath \
+ dialog_path::add dialog_path::edit dialog_path::commit \
+ [_ "Pd search path for objects, help, fonts, and other files"] \
+ 400 300
+
+ frame $mytoplevel.extraframe
+ pack $mytoplevel.extraframe -side bottom -pady 2m
+ checkbutton $mytoplevel.extraframe.extra -text [_ "Use standard extensions"] \
+ -variable use_standard_extensions_button -anchor w
+ checkbutton $mytoplevel.extraframe.verbose -text [_ "Verbose"] \
+ -variable verbose_button -anchor w
+ pack $mytoplevel.extraframe.extra $mytoplevel.extraframe.verbose \
+ -side left -expand 1
+}
+
+
+
+############ pdtk_path_dialog -- dialog window for search path #########
+proc ::dialog_path::choosePath { currentpath title } {
+ if {$currentpath == ""} {
+ set currentpath "~"
+ }
+ return [tk_chooseDirectory -initialdir $currentpath -title $title]
+}
+
+proc ::dialog_path::add {} {
+ return [::dialog_path::choosePath "" {Add a new path}]
+}
+
+proc ::dialog_path::edit { currentpath } {
+ return [::dialog_path::choosePath $currentpath "Edit existing path \[$currentpath\]"]
+}
+
+proc ::dialog_path::commit { new_path } {
+ global use_standard_extensions_button
+ global verbose_button
+
+ set ::sys_searchpath $new_path
+ pdsend "pd path-dialog $use_standard_extensions_button $verbose_button $::sys_searchpath"
+}
+
diff --git a/pd/tcl/dialog_startup.tcl b/pd/tcl/dialog_startup.tcl
new file mode 100644
index 000000000..52c5f6474
--- /dev/null
+++ b/pd/tcl/dialog_startup.tcl
@@ -0,0 +1,96 @@
+
+package provide dialog_startup 0.1
+
+package require scrollboxwindow
+
+namespace eval dialog_startup {
+ variable defeatrt_flag 0
+
+ namespace export pdtk_startup_dialog
+}
+
+########## pdtk_startup_dialog -- dialog window for startup options #########
+# Create a simple modal window with an entry widget
+# for editing/adding a startup command
+# (the next-best-thing to in-place editing)
+proc ::dialog_startup::chooseCommand { prompt initialValue } {
+ global cmd
+ set cmd $initialValue
+
+ toplevel .inputbox
+ wm title .inputbox $prompt
+ wm group .inputbox .
+ wm minsize .inputbox 450 30
+ wm resizable .inputbox 0 0
+ wm geom .inputbox "450x30"
+ # not all Tcl/Tk versions or platforms support -topmost, so catch the error
+ catch {wm attributes $mytoplevel -topmost 1}
+
+ button .inputbox.button -text [_ "OK"] -command { destroy .inputbox } \
+ -width [::msgcat::mcmax [_ "OK"]]
+
+ entry .inputbox.entry -width 50 -textvariable cmd
+ pack .inputbox.button -side right
+ bind .inputbox.entry <KeyPress-Return> { destroy .inputbox }
+ bind .inputbox.entry <KeyPress-Escape> { destroy .inputbox }
+ pack .inputbox.entry -side right -expand 1 -fill x -padx 2m
+
+ focus .inputbox.entry
+
+ raise .inputbox
+ wm transient .inputbox
+ grab .inputbox
+ tkwait window .inputbox
+
+ return $cmd
+}
+
+proc ::dialog_startup::add {} {
+ return [chooseCommand [_ "Add new library"] ""]
+}
+
+proc ::dialog_startup::edit { current_library } {
+ return [chooseCommand [_ "Edit library"] $current_library]
+}
+
+proc ::dialog_startup::commit { new_startup } {
+ variable defeatrt_button
+ set ::startup_libraries $new_startup
+
+ pdsend "pd startup-dialog $defeatrt_button [pdtk_encodedialog $::startup_flags] $::startup_libraries"
+}
+
+# set up the panel with the info from pd
+proc ::dialog_startup::pdtk_startup_dialog {mytoplevel defeatrt flags} {
+ variable defeatrt_button $defeatrt
+ if {$flags ne ""} {variable ::startup_flags $flags}
+
+ if {[winfo exists $mytoplevel]} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ } else {
+ create_dialog $mytoplevel
+ }
+}
+
+proc ::dialog_startup::create_dialog {mytoplevel} {
+ ::scrollboxwindow::make $mytoplevel $::startup_libraries \
+ dialog_startup::add dialog_startup::edit dialog_startup::commit \
+ [_ "Pd libraries to load on startup"] \
+ 400 300
+
+ label $mytoplevel.entryname -text [_ "Startup flags:"]
+ entry $mytoplevel.entry -textvariable ::startup_flags -width 60
+ pack $mytoplevel.entryname $mytoplevel.entry -side left
+ pack $mytoplevel.entry -side right -padx 2m -fill x -expand 1
+
+ frame $mytoplevel.defeatrtframe
+ pack $mytoplevel.defeatrtframe -side bottom -fill x -pady 2m
+ if {$::windowingsystem ne "win32"} {
+ checkbutton $mytoplevel.defeatrtframe.defeatrt -anchor w \
+ -text [_ "Defeat real-time scheduling"] \
+ -variable ::dialog_startup::defeatrt_button
+ pack $mytoplevel.defeatrtframe.defeatrt -side left
+ }
+}
+
diff --git a/pd/tcl/helpbrowser.tcl b/pd/tcl/helpbrowser.tcl
new file mode 100644
index 000000000..bcec1fc56
--- /dev/null
+++ b/pd/tcl/helpbrowser.tcl
@@ -0,0 +1,272 @@
+
+package provide helpbrowser 0.1
+
+namespace eval ::helpbrowser:: {
+ variable libdirlist
+ variable helplist
+ variable reference_count
+ variable reference_paths
+ variable doctypes "*.{pd,pat,mxb,mxt,help,txt,htm,html,pdf}"
+
+ namespace export open_helpbrowser
+}
+
+# TODO remove the doc_ prefix on procs where its not needed
+# TODO rename .help_browser to .helpbrowser
+# TODO enter and up/down/left/right arrow key bindings for nav
+
+################## help browser and support functions #########################
+proc ::helpbrowser::open_helpbrowser {} {
+ if { [winfo exists .help_browser.frame] } {
+ wm deiconify .help_browser
+ raise .help_browser
+ } else {
+ toplevel .help_browser -class HelpBrowser
+ wm group .help_browser .
+ wm transient .help_browser
+ wm title .help_browser [_ "Help Browser"]
+ bind .help_browser <$::modifier-Key-w> "wm withdraw .help_browser"
+
+ if {$::windowingsystem eq "aqua"} {
+ .help_browser configure -menu $::dialog_menubar
+ }
+
+ wm resizable .help_browser 0 0
+ frame .help_browser.frame
+ pack .help_browser.frame -side top -fill both
+ build_references
+ make_rootlistbox .help_browser.frame
+ }
+}
+
+# make the root listbox of the help browser using the pre-built lists
+proc ::helpbrowser::make_rootlistbox {base} {
+ variable libdirlist
+ variable helplist
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b $base.root]" -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
+ -side left -fill both -expand 1
+ foreach item [concat [lsort [concat $libdirlist $helplist]]] {
+ $current_listbox insert end $item
+ }
+ bind $current_listbox <Button-1> \
+ [list ::helpbrowser::root_navigate %W %x %y]
+ bind $current_listbox <Key-Return> \
+ [list ::helpbrowser::root_navigate %W %x %y]
+ bind $current_listbox <Double-ButtonRelease-1> \
+ [list ::helpbrowser::root_doubleclick %W %x %y]
+ bind $current_listbox <$::modifier-Key-o> \
+ [list ::helpbrowser::root_doubleclick %W %x %y]
+}
+
+# navigate into a library/directory from the root
+proc ::helpbrowser::root_navigate {window x y} {
+ variable reference_paths
+ if {[set item [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set filename $reference_paths($item)
+ if {[file isdirectory $filename]} {
+ make_liblistbox [winfo parent $window] $filename
+ }
+}
+
+# double-click action to open the folder
+proc ::helpbrowser::root_doubleclick {window x y} {
+ variable reference_paths
+ if {[set listname [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir [file dirname $reference_paths($listname)]
+ set filename [file tail $reference_paths($listname)]
+ ::pdwindow::verbose 0 "menu_doc_open $dir $filename"
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+# make the listbox to show the first level contents of a libdir
+proc ::helpbrowser::make_liblistbox {base dir} {
+ variable doctypes
+ catch { eval destroy [lrange [winfo children $base] 2 end] } errorMessage
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b $base.listbox0]" -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
+ -side left -fill both -expand 1
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
+ if {[glob -directory $item -nocomplain -types {f} -- $doctypes] ne "" ||
+ [glob -directory $item -nocomplain -types {d} -- *] ne ""} {
+ $current_listbox insert end "[file tail $item]/"
+ }
+ }
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ *-{help,meta}.pd]] {
+ $current_listbox insert end [file tail $item]
+ }
+ $current_listbox insert end "___________________________"
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ *.txt]] {
+ $current_listbox insert end [file tail $item]
+ }
+ bind $current_listbox <Button-1> \
+ [list ::helpbrowser::dir_navigate $dir 1 %W %x %y]
+ bind $current_listbox <Double-ButtonRelease-1> \
+ [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
+ bind $current_listbox <Key-Return> \
+ [list ::helpbrowser::dir_doubleclick $dir 1 %W %x %y]
+}
+
+proc ::helpbrowser::doc_make_listbox {base dir count} {
+ variable doctypes
+ # check for [file readable]?
+ # requires Tcl 8.5 but probably deals with special chars better:
+ # destroy {*}[lrange [winfo children $base] [expr {2 * $count}] end]
+ if { [catch { eval destroy [lrange [winfo children $base] \
+ [expr { 2 * $count }] end] } errorMessage] } {
+ ::pdwindow::error "doc_make_listbox: error listing $dir\n"
+ }
+ # exportselection 0 looks good, but selection gets easily out-of-sync
+ set current_listbox [listbox "[set b "$base.listbox$count"]-list" \
+ -yscrollcommand "$b-scroll set" \
+ -highlightbackground white -highlightthickness 5 \
+ -highlightcolor "#D6E5FC" -selectborderwidth 0 \
+ -height 20 -width 23 -exportselection 0 -bd 0]
+ pack $current_listbox [scrollbar "$b-scroll" -command "$current_listbox yview"] \
+ -side left -fill both -expand 1
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
+ $current_listbox insert end "[file tail $item]/"
+ }
+ foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- \
+ $doctypes]] {
+ $current_listbox insert end [file tail $item]
+ }
+ bind $current_listbox <Button-1> \
+ "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
+ bind $current_listbox <Key-Right> \
+ "::helpbrowser::dir_navigate {$dir} $count %W %x %y"
+ bind $current_listbox <Double-ButtonRelease-1> \
+ "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
+ bind $current_listbox <Key-Return> \
+ "::helpbrowser::dir_doubleclick {$dir} $count %W %x %y"
+}
+
+# navigate into an actual directory
+proc ::helpbrowser::dir_navigate {dir count window x y} {
+ if {[set newdir [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ set dir_to_open [file join $dir $newdir]
+ if {[file isdirectory $dir_to_open]} {
+ doc_make_listbox [winfo parent $window] $dir_to_open [incr count]
+ }
+}
+
+proc ::helpbrowser::dir_doubleclick {dir count window x y} {
+ if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+proc ::helpbrowser::rightclickmenu {dir count window x y} {
+ if {[set filename [$window get [$window index "@$x,$y"]]] eq {}} {
+ return
+ }
+ if { [catch {menu_doc_open $dir $filename} fid] } {
+ ::pdwindow::error "Could not open $dir/$filename\n"
+ }
+}
+
+#------------------------------------------------------------------------------#
+# build help browser trees
+
+# TODO check file timestamp against timestamp of when tree was built
+
+proc ::helpbrowser::findfiles {basedir pattern} {
+ set basedir [string trimright [file join [file normalize $basedir] { }]]
+ set filelist {}
+
+ # Look in the current directory for matching files, -type {f r}
+ # means ony readable normal files are looked at, -nocomplain stops
+ # an error being thrown if the returned list is empty
+ foreach filename [glob -nocomplain -type {f r} -path $basedir $pattern] {
+ lappend filelist $filename
+ }
+
+ foreach dirName [glob -nocomplain -type {d r} -path $basedir *] {
+ set subdirlist [findfiles $dirName $pattern]
+ if { [llength $subdirlist] > 0 } {
+ foreach subdirfile $subdirlist {
+ lappend filelist $subdirfile
+ }
+ }
+ }
+ return $filelist
+}
+
+proc ::helpbrowser::add_entry {reflist entry} {
+ variable libdirlist
+ variable helplist
+ variable reference_paths
+ variable reference_count
+ set entryname [file tail $entry]
+ # if we are checking libdirs, then check to see if there is already a
+ # libdir with that name that has been discovered in the path. If so, dump
+ # a warning. The trailing slash on $entryname is added below when
+ # $entryname is a dir
+ if {$reflist eq "libdirlist" && [lsearch -exact $libdirlist $entryname/] > -1} {
+ ::pdwindow::error "WARNING: duplicate '$entryname' library found!\n"
+ ::pdwindow::error " '$reference_paths($entryname/)' is active\n"
+ ::pdwindow::error " '$entry' is duplicate\n"
+ incr reference_count($entryname)
+ append entryname "/ ($reference_count($entryname))"
+ } else {
+ set reference_count($entryname) 1
+ if {[file isdirectory $entry]} {
+ append entryname "/"
+ }
+ }
+ lappend $reflist $entryname
+ set reference_paths($entryname) $entry
+}
+
+proc ::helpbrowser::build_references {} {
+ variable libdirlist {" Pure Data/" "-----------------------"}
+ variable helplist {}
+ variable reference_count
+ variable reference_paths
+
+ array set reference_count {}
+ array set reference_paths [list \
+ " Pure Data/" $::sys_libdir/doc \
+ "-----------------------" "" \
+ ]
+ foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
+ if { ! [file isdirectory $pathdir]} {continue}
+ # Fix the directory name, this ensures the directory name is in the
+ # native format for the platform and contains a final directory seperator
+ set dir [string trimright [file join [file normalize $pathdir] { }]]
+ ## find the libdirs
+ foreach filename [glob -nocomplain -type d -path $dir "*"] {
+ add_entry libdirlist $filename
+ }
+ ## find the stray help patches
+ foreach filename [glob -nocomplain -type f -path $dir "*-help.pd"] {
+ add_entry helplist $filename
+ }
+ }
+}
+
+
+
+
+
diff --git a/pd/tcl/opt_parser.tcl b/pd/tcl/opt_parser.tcl
index d304e045c..c34baf6d9 100644
--- a/pd/tcl/opt_parser.tcl
+++ b/pd/tcl/opt_parser.tcl
@@ -3,35 +3,44 @@ package provide opt_parser 0.1
namespace eval opt_parser {
# list of option vars (keys are long option names)
variable optlist
+ # option behavior <set|lappend>
+ variable optbehavior
variable optprefix {-}
}
proc opt_parser::init {optdata} {
variable optlist
- array unset optlist
- array set optlist {}
+ variable optbehavior
+ array unset optlist ; array set optlist {}
+ array unset optbehavior ; array set optbehavior {}
foreach item $optdata {
- foreach {longname varlist} $item {
- if {[llength $varlist] < 1} {
- return -code error "usage: init { {optname {var1 var2 ...}} ... }"
+ foreach {optName behavior varlist} $item {
+ if {[llength $varlist] < 1 || [lsearch -exact {set lappend} $behavior] == -1} {
+ return -code error "usage: init { {optname <set|lappend> {var1 var2 ...}} ... }"
}
- set optlist($longname) $varlist
+ set optlist($optName) $varlist
+ set optbehavior($optName) $behavior
}
}
}
proc opt_parser::get_options {argv {opts {}}} {
- set ignore_unknown_flags 0
+ # second argument are internal options
+ # (like 'ignore_unknown_flags <0|1>')
foreach {k v} $opts {set $k $v}
+ set ignore_unknown_flags 0
variable optlist
+ variable optbehavior
variable optprefix
# zero all the options 1st var
foreach optName [array names optlist] {
uplevel [list set [lindex $optlist($optName) 0] 0]
- for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
- uplevel [list set [lindex $optlist($optName) $i] [list]]
+ if {$optbehavior($optName) == {lappend}} {
+ for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
+ uplevel [list set [lindex $optlist($optName) $i] [list]]
+ }
}
}
@@ -41,16 +50,15 @@ proc opt_parser::get_options {argv {opts {}}} {
set argc [llength $argv]
for {set i 0} {$i < $argc} {} {
# get i-th arg
- set argv_i [lindex $argv $i]
+ set optName [lindex $argv $i]
incr i
# if it's not an option, stop here, and add to residualArgs
- if {![regexp ^$optprefix $argv_i]} {
- lappend residualArgs $argv_i
+ if {![regexp ^$optprefix $optName]} {
+ lappend residualArgs $optName
continue
}
- set optName [regsub ^$optprefix $argv_i {}]
if {[info exists optlist($optName)]} {
set varlist $optlist($optName)
uplevel [list set [lindex $optlist($optName) 0] 1]
@@ -59,9 +67,9 @@ proc opt_parser::get_options {argv {opts {}}} {
while {$n_required_opt_args > 0} {
incr n_required_opt_args -1
if {$i >= $argc} {
- return -code error "not enough arguments for option $optprefix$optName"
+ return -code error "not enough arguments for option $optName"
}
- uplevel [list lappend [lindex $varlist $j] [lindex $argv $i]]
+ uplevel [list $optbehavior($optName) [lindex $varlist $j] [lindex $argv $i]]
incr j
incr i
}
@@ -70,7 +78,7 @@ proc opt_parser::get_options {argv {opts {}}} {
lappend residualArgs $argv_i
continue
} else {
- return -code error "unknown option: $optprefix$optName"
+ return -code error "unknown option: $optName"
}
}
}
diff --git a/pd/tcl/pd-gui.tcl b/pd/tcl/pd-gui.tcl
index 6dfe16632..d379c459d 100644
--- a/pd/tcl/pd-gui.tcl
+++ b/pd/tcl/pd-gui.tcl
@@ -8,15 +8,18 @@
# "." automatically gets a window, we don't want it. Withdraw it before doing
# anything else, so that we don't get the automatic window flashing for a
# second while pd loads.
-wm withdraw .
-
-puts -------------------------------pd-gui.tcl-----------------------------------
+if { [catch {wm withdraw .} fid] } { exit 2 }
package require Tcl 8.3
package require Tk
-package require Tk
-if {[tk windowingsystem] ne "win32"} {package require msgcat}
-# TODO figure out msgcat issue on Windows
+#package require tile
+## replace Tk widgets with Ttk widgets on 8.5
+#namespace import -force ttk::*
+
+package require msgcat
+# TODO create a constructor in each package to create things at startup, that
+# way they can be easily be modified by startup scripts
+# TODO create alt-Enter/Cmd-I binding to bring up Properties panels
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
@@ -27,26 +30,58 @@ package require pdwindow
package require dialog_array
package require dialog_audio
package require dialog_canvas
+package require dialog_data
package require dialog_font
package require dialog_gatom
package require dialog_iemgui
+package require dialog_message
package require dialog_midi
+package require dialog_path
+package require dialog_startup
+package require helpbrowser
+package require pd_menucommands
+package require opt_parser
package require pdtk_canvas
package require pdtk_text
+package require pdtk_textwindow
# TODO eliminate this kludge:
package require wheredoesthisgo
+package require pd_guiprefs
+
+#------------------------------------------------------------------------------#
+# import functions into the global namespace
+
+# gui preferences
+namespace import ::pd_guiprefs::init
+namespace import ::pd_guiprefs::update_recentfiles
+namespace import ::pd_guiprefs::write_recentfiles
+# make global since they are used throughout
+namespace import ::pd_menucommands::*
# import into the global namespace for backwards compatibility
namespace import ::pd_connect::pdsend
namespace import ::pdwindow::pdtk_post
+namespace import ::pdwindow::pdtk_pd_dio
+namespace import ::pdwindow::pdtk_pd_dsp
+namespace import ::pdwindow::pdtk_pd_meters
+namespace import ::pdtk_canvas::pdtk_canvas_popup
+namespace import ::pdtk_canvas::pdtk_canvas_editmode
+namespace import ::pdtk_canvas::pdtk_canvas_getscroll
+namespace import ::pdtk_canvas::pdtk_canvas_setparents
+namespace import ::pdtk_canvas::pdtk_canvas_reflecttitle
+namespace import ::pdtk_canvas::pdtk_canvas_menuclose
namespace import ::dialog_array::pdtk_array_dialog
namespace import ::dialog_audio::pdtk_audio_dialog
namespace import ::dialog_canvas::pdtk_canvas_dialog
+namespace import ::dialog_data::pdtk_data_dialog
+namespace import ::dialog_find::pdtk_couldnotfind
namespace import ::dialog_font::pdtk_canvas_dofont
namespace import ::dialog_gatom::pdtk_gatom_dialog
namespace import ::dialog_iemgui::pdtk_iemgui_dialog
namespace import ::dialog_midi::pdtk_midi_dialog
namespace import ::dialog_midi::pdtk_alsa_midi_dialog
+namespace import ::dialog_path::pdtk_path_dialog
+namespace import ::dialog_startup::pdtk_startup_dialog
# hack - these should be better handled in the C code
namespace import ::dialog_array::pdtk_array_listview_new
@@ -57,10 +92,16 @@ namespace import ::dialog_array::pdtk_array_listview_closeWindow
#------------------------------------------------------------------------------#
# global variables
+# this is a wide array of global variables that are used throughout the GUI.
+# they can be used in plugins to check the status of various things since they
+# should all have been properly initialized by the time startup plugins are
+# loaded.
+
set PD_MAJOR_VERSION 0
set PD_MINOR_VERSION 0
set PD_BUGFIX_VERSION 0
set PD_TEST_VERSION ""
+set done_init 0
set TCL_MAJOR_VERSION 0
set TCL_MINOR_VERSION 0
@@ -69,8 +110,13 @@ set TCL_BUGFIX_VERSION 0
# for testing which platform we are running on ("aqua", "win32", or "x11")
set windowingsystem ""
-# variable for vwait so that 'pd-gui' will timeout if 'pd' never shows up
-set wait4pd "init"
+# args about how much and where to log
+set loglevel 2
+set stderr 0
+
+# connection between 'pd' and 'pd-gui'
+set host ""
+set port 0
# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
set font_family "courier"
@@ -78,45 +124,103 @@ set font_weight "normal"
# sizes of chars for each of the Pd fixed font sizes:
# fontsize width(pixels) height(pixels)
set font_fixed_metrics {
- 8 5 10
- 9 6 11
- 10 6 13
- 12 7 15
+ 8 6 11
+ 9 6 12
+ 10 7 13
+ 12 9 16
14 8 17
16 10 20
18 11 22
- 24 14 30
+ 24 15 25
30 18 37
- 36 22 45
+ 36 25 45
}
+set font_measured_metrics {}
# root path to lib of Pd's files, see s_main.c for more info
set sys_libdir {}
# root path where the pd-gui.tcl GUI script is located
set sys_guidir {}
-
-set audioapi_list {}
-set midiapi_list {}
+# user-specified search path for objects, help, fonts, etc.
+set sys_searchpath {}
+# hard-coded search patch for objects, help, plugins, etc.
+set sys_staticpath {}
+# the path to the folder where the current plugin is being loaded from
+set current_plugin_loadpath {}
+# a list of plugins that were loaded
+set loaded_plugins {}
+# list of command line flags set at startup
+set startup_flags {}
+# list of libraries loaded on startup
+set startup_libraries {}
+# start dirs for new files and open panels
+set filenewdir [pwd]
+set fileopendir [pwd]
+
+
+# lists of audio/midi devices and APIs for prefs dialogs
+set audio_apilist {}
+set audio_indevlist {}
+set audio_outdevlist {}
+set midi_apilist {}
+set midi_indevlist {}
+set midi_outdevlist {}
set pd_whichapi 0
set pd_whichmidiapi 0
# current state of the DSP
set dsp 0
+# state of the peak meters in the Pd window
+set meters 0
# the toplevel window that currently is on top and has focus
set focused_window .
-# TODO figure out how to get all windows into the menu_windowlist
-# store list of parent windows for Window menu
-set menu_windowlist {}
-# store that last 10 files that were opened
+# store that last 5 files that were opened
set recentfiles_list {}
-set total_recentfiles 10
-# keep track of the location of popup menu for CanvasWindows
-set popup_xpix 0
-set popup_ypix 0
+set total_recentfiles 5
+# keep track of the location of popup menu for PatchWindows, in canvas coords
+set popup_xcanvas 0
+set popup_ycanvas 0
+# modifier for key commands (Ctrl/Control on most platforms, Cmd/Mod1 on MacOSX)
+set modifier ""
+# current state of the Edit Mode menu item
+set editmode_button 0
+
## per toplevel/patch data
-# store editmode for each open canvas, starting with a blank array
-array set editmode {}
+# window location modifiers
+set menubarsize 0 ;# Mac OS X and other platforms have a menubar on top
+set windowframex 0 ;# different platforms have different window frames
+set windowframey 0 ;# different platforms have different window frames
+# patch properties
+array set editmode {} ;# store editmode for each open patch canvas
+array set editingtext {};# if an obj, msg, or comment is being edited, per patch
+array set loaded {} ;# store whether a patch has completed loading
+array set xscrollable {};# keep track of whether the scrollbars are present
+array set yscrollable {}
+# patch window tree, these might contain patch IDs without a mapped toplevel
+array set windowname {} ;# window names based on mytoplevel IDs
+array set childwindows {} ;# all child windows based on mytoplevel IDs
+array set parentwindows {} ;# topmost parent window ID based on mytoplevel IDs
+
+# variables for holding the menubar to allow for configuration by plugins
+set ::pdwindow_menubar ".menubar"
+set ::patch_menubar ".menubar"
+set ::dialog_menubar ""
+
+# minimum size of the canvas window of a patch
+set canvas_minwidth 50
+set canvas_minheight 20
+
+# undo states
+set ::undo_action "no"
+set ::redo_action "no"
+set ::undo_toplevel "."
+
+
+namespace eval ::pdgui:: {
+ variable scriptname [ file normalize [ info script ] ]
+}
+
#------------------------------------------------------------------------------#
# coding style
@@ -129,17 +233,23 @@ array set editmode {}
# - if a menu_* proc opens a dialog panel, that proc is called menu_*_dialog
# - use "eq/ne" for string comparison, NOT "==/!=" (http://wiki.tcl.tk/15323)
#
+#
## Names for Common Variables
#----------------------------
-#
# variables named after the Tk widgets they represent
+# $window = any kind of Tk widget that can be a Tk 'window'
# $mytoplevel = a window id made by a 'toplevel' command
-# $mygfxstub = a window id made by a 'toplevel' command via gfxstub/x_gui.c
-# $menubar = the 'menu' attached to each 'toplevel'
-# $mymenu = 'menu' attached to the menubar
-# $menuitem = 'menu' item
-# $mycanvas = 'canvas'
-# $canvasitem = 'canvas' item
+# $gfxstub = a 'toplevel' window id for dialogs made in gfxstub/x_gui.c
+# $menubar = the 'menu' attached to each 'toplevel'
+# $mymenu = 'menu' attached to the menubar, like the File menu
+# $tkcanvas = a Tk 'canvas', which is the root of each patch
+#
+#
+## Dialog Panel Types
+#----------------------------
+# global (only one): find, sendmessage, prefs, helpbrowser
+# per-canvas: font, canvas properties (created with a message from pd)
+# per object: gatom, iemgui, array, data structures (created with a message from pd)
#
#
## Prefix Names for procs
@@ -150,18 +260,6 @@ array set editmode {}
# ------------------------------------------------------------------------------
# init functions
-proc set_pd_version {versionstring} {
- regexp -- {.*([0-9])\.([0-9]+)[\.\-]([0-9]+)([^0-9]?.*)} $versionstring \
- wholematch \
- ::PD_MAJOR_VERSION ::PD_MINOR_VERSION ::PD_BUGFIX_VERSION ::PD_TEST_VERSION
-}
-
-proc set_tcl_version {} {
- regexp {([0-9])\.([0-9])\.([0-9]+)} [info patchlevel] \
- wholematch \
- ::TCL_MAJOR_VERSION ::TCL_MINOR_VERSION ::TCL_BUGFIX_VERSION
-}
-
# root paths to find Pd's files where they are installed
proc set_pd_paths {} {
set ::sys_guidir [file normalize [file dirname [info script]]]
@@ -175,6 +273,8 @@ proc init_for_platform {} {
switch -- $::windowingsystem {
"x11" {
+ set ::modifier "Control"
+ option add *PatchWindow*Canvas.background "white" startupFile
# add control to show/hide hidden files in the open panel (load
# the tk_getOpenFile dialog once, otherwise it will not work)
catch {tk_getOpenFile -with-invalid-argument}
@@ -188,8 +288,32 @@ proc init_for_platform {} {
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 0
+ # Tk handles the window placement differently on each
+ # platform. With X11, the x,y placement refers to the window
+ # frame's upper left corner. http://wiki.tcl.tk/11502
+ set ::windowframex 3
+ set ::windowframey 53
+ # TODO add wm iconphoto/iconbitmap here if it makes sense
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "left_ptr"
+ set ::cursor_runmode_clickme "arrow"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
+ set ::cursor_editmode_resize "sb_h_double_arrow"
}
"aqua" {
+ set ::modifier "Mod1"
+ option add *DialogWindow*background "#E8E8E8" startupFile
+ option add *DialogWindow*Entry.highlightBackground "#E8E8E8" startupFile
+ option add *DialogWindow*Button.highlightBackground "#E8E8E8" startupFile
+ option add *DialogWindow*Entry.background "white" startupFile
+ # Mac OS X needs a menubar all the time
+ set ::dialog_menubar ".menubar"
# set file types that open/save recognize
set ::filetypes \
[list \
@@ -197,10 +321,34 @@ proc init_for_platform {} {
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files (.pat)"] {.pat} ] \
[list [_ "Max Text Files (.mxt)"] {.mxt} ] \
- ]
+ ]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 22
+ # Tk handles the window placement differently on each platform, on
+ # Mac OS X, the x,y placement refers to the content window's upper
+ # left corner (not of the window frame) http://wiki.tcl.tk/11502
+ set ::windowframex 0
+ set ::windowframey 0
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "arrow"
+ set ::cursor_runmode_clickme "center_ptr"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
+ set ::cursor_editmode_resize "sb_h_double_arrow"
}
"win32" {
+ set ::modifier "Control"
+ option add *PatchWindow*Canvas.background "white" startupFile
+ # fix menu font size on Windows with tk scaling = 1
font create menufont -family Tahoma -size -11
+ option add *Menu.font menufont startupFile
+ option add *HelpBrowser*font menufont startupFile
+ option add *DialogWindow*font menufont startupFile
+ option add *PdWindow*font menufont startupFile
+ option add *ErrorDialog*font menufont startupFile
# set file types that open/save recognize
set ::filetypes \
[list \
@@ -209,6 +357,25 @@ proc init_for_platform {} {
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
]
+ # some platforms have a menubar on the top, so place below them
+ set ::menubarsize 0
+ # Tk handles the window placement differently on each platform, on
+ # Mac OS X, the x,y placement refers to the content window's upper
+ # left corner. http://wiki.tcl.tk/11502
+ # TODO this probably needs a script layer: http://wiki.tcl.tk/11291
+ set ::windowframex 0
+ set ::windowframey 0
+ # TODO use 'winico' package for full, hicolor icon support
+ wm iconbitmap . -default [file join $::sys_guidir pd.ico]
+ # mouse cursors for all the different modes
+ set ::cursor_runmode_nothing "right_ptr"
+ set ::cursor_runmode_clickme "arrow"
+ set ::cursor_runmode_thicken "sb_v_double_arrow"
+ set ::cursor_runmode_addpoint "plus"
+ set ::cursor_editmode_nothing "hand2"
+ set ::cursor_editmode_connect "circle"
+ set ::cursor_editmode_disconnect "X_cursor"
+ set ::cursor_editmode_resize "sb_h_double_arrow"
}
}
}
@@ -217,26 +384,32 @@ proc init_for_platform {} {
# locale handling
# official GNU gettext msgcat shortcut
-if {[tk windowingsystem] ne "win32"} {
- proc _ {s} {return [::msgcat::mc $s]}
-} else {
- proc _ {s} {return $s}
-}
+proc _ {s} {return [::msgcat::mc $s]}
proc load_locale {} {
- if {[tk windowingsystem] ne "win32"} {
- ::msgcat::mcload [file join [file dirname [info script]] .. po]
+ # on any UNIX-like environment, Tcl should automatically use LANG, LC_ALL,
+ # etc. otherwise we need to dig it up. Mac OS X only uses LANG, etc. from
+ # the Terminal, and Windows doesn't have LANG, etc unless you manually set
+ # it up yourself. Windows apps don't use the locale env vars usually.
+ if {$::tcl_platform(os) eq "Darwin" && ! [info exists ::env(LANG)]} {
+ # http://thread.gmane.org/gmane.comp.lang.tcl.mac/5215
+ # http://thread.gmane.org/gmane.comp.lang.tcl.mac/6433
+ if {![catch "exec defaults read com.apple.dock loc" lang]} {
+ ::msgcat::mclocale $lang
+ } elseif {![catch "exec defaults read NSGlobalDomain AppleLocale" lang]} {
+ ::msgcat::mclocale $lang
+ }
+ } elseif {$::tcl_platform(platform) eq "windows"} {
+ # using LANG on Windows is useful for easy debugging
+ if {[info exists ::env(LANG)] && $::env(LANG) ne "C" && $::env(LANG) ne ""} {
+ ::msgcat::mclocale $::env(LANG)
+ } elseif {![catch {package require registry}]} {
+ ::msgcat::mclocale [string tolower \
+ [string range \
+ [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
+ }
}
-
- # for Windows
- #set locale "en" ;# Use whatever is right for your app
- #if {[catch {package require registry}]} {
- # tk_messageBox -icon error -message "Could not get locale from registry"
- #} else {
- # set locale [string tolower \
- # [string range \
- # [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
- #}
+ ::msgcat::mcload [file join [file dirname [info script]] .. po]
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8
@@ -258,32 +431,32 @@ proc get_font_for_size {size} {
# always do a good job of choosing in respect to Pd's needs. So this chooses
# from a list of fonts that are known to work well with Pd.
proc find_default_font {} {
- set testfonts {Inconsolata "Courier New" "Liberation Mono" FreeMono \
- "DejaVu Sans Mono" "Bitstream Vera Sans Mono"}
+ set testfonts {"DejaVu Sans Mono" "Bitstream Vera Sans Mono" \
+ "Inconsolata" "Courier 10 Pitch" "Andale Mono" "Droid Sans Mono"}
foreach family $testfonts {
if {[lsearch -exact -nocase [font families] $family] > -1} {
set ::font_family $family
break
}
}
- puts "DEFAULT FONT: $::font_family"
+ ::pdwindow::verbose 0 "Default font: $::font_family\n"
}
proc set_base_font {family weight} {
if {[lsearch -exact [font families] $family] > -1} {
set ::font_family $family
} else {
- pdtk_post [format \
- [_ "WARNING: Font family '%s' not found, using default (%s)"] \
- $family $::font_family]
+ ::pdwindow::post [format \
+ [_ "WARNING: Font family '%s' not found, using default (%s)\n"] \
+ $family $::font_family]
}
if {[lsearch -exact {bold normal} $weight] > -1} {
set ::font_weight $weight
set using_defaults 0
} else {
- pdtk_post [format \
- [_ "WARNING: Font weight '%s' not found, using default (%s)"] \
- $weight $::font_weight]
+ ::pdwindow::post [format \
+ [_ "WARNING: Font weight '%s' not found, using default (%s)\n"] \
+ $weight $::font_weight]
}
}
@@ -297,17 +470,22 @@ proc fit_font_into_metrics {} {
-size [expr {-$height}]
set height2 $height
set giveup 0
- while {[font measure $myfont M] > $width} {
+ while {[font measure $myfont M] > $width || \
+ [font metrics $myfont -linespace] > $height} {
incr height2 -1
font configure $myfont -size [expr {-$height2}]
if {$height2 * 2 <= $height} {
set giveup 1
+ set ::font_measured_metrics $::font_fixed_metrics
break
}
}
+ set ::font_measured_metrics \
+ "$::font_measured_metrics $size\
+ [font measure $myfont M] [font metrics $myfont -linespace]"
if {$giveup} {
- pdtk_post [format \
- [_ "ERROR: %s failed to find font size (%s) that fits into %sx%s!"]\
+ ::pdwindow::post [format \
+ [_ "WARNING: %s failed to find font size (%s) that fits into %sx%s!\n"]\
[lindex [info level 0] 0] $size $width $height]
continue
}
@@ -318,46 +496,83 @@ proc fit_font_into_metrics {} {
# ------------------------------------------------------------------------------
# procs called directly by pd
-# this is only called when 'pd' starts 'pd-gui', not the other way around
-proc pdtk_pd_startup {versionstring audio_apis midi_apis sys_font sys_fontweight} {
-# pdtk_post "-------------- pdtk_pd_startup ----------------"
-# pdtk_post "version: $versionstring"
-# pdtk_post "audio_apis: $audio_apis"
-# pdtk_post "midi_apis: $midi_apis"
-# pdtk_post "sys_font: $sys_font"
-# pdtk_post "sys_fontweight: $sys_fontweight"
+proc pdtk_pd_startup {major minor bugfix test
+ audio_apis midi_apis sys_font sys_fontweight} {
+ set ::PD_MAJOR_VERSION $major
+ set ::PD_MINOR_VERSION $minor
+ set ::PD_BUGFIX_VERSION $bugfix
+ set ::PD_TEST_VERSION $test
set oldtclversion 0
- pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_fixed_metrics"
- set_pd_version $versionstring
- set ::audioapi_list $audio_apis
- set ::midiapi_list $midi_apis
+ set ::audio_apilist $audio_apis
+ set ::midi_apilist $midi_apis
if {$::tcl_version >= 8.5} {find_default_font}
set_base_font $sys_font $sys_fontweight
fit_font_into_metrics
- # TODO what else is needed from the original?
- set ::wait4pd "started"
+ ::pd_guiprefs::init
+ pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_measured_metrics"
+ ::pd_bindings::class_bindings
+ ::pd_bindings::global_bindings
+ ::pd_menus::create_menubar
+ ::pdtk_canvas::create_popup
+ ::pdwindow::create_window
+ ::pd_menus::configure_for_pdwindow
+ load_startup_plugins
+ open_filestoopen
+ set ::done_init 1
}
##### routine to ask user if OK and, if so, send a message on to Pd ######
-# TODO add 'mytoplevel' once merged to 0.43, with -parent
-proc pdtk_check {message reply_to_pd default} {
- # TODO this should use -parent and -title, but the hard part is figuring
- # out how to get the values for those without changing g_editor.c
- set answer [tk_messageBox -type yesno -icon question -default $default \
- -message [_ $message]]
+proc pdtk_check {mytoplevel message reply_to_pd default} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ if {$::windowingsystem eq "win32"} {
+ set answer [tk_messageBox -message [_ $message] -type yesno -default $default \
+ -icon question -title [wm title $mytoplevel]]
+ } else {
+ set answer [tk_messageBox -message [_ $message] -type yesno \
+ -default $default -parent $mytoplevel -icon question]
+ }
if {$answer eq "yes"} {
pdsend $reply_to_pd
}
}
-proc pdtk_fixwindowmenu {} {
- # TODO canvas_updatewindowlist() sets up the menu_windowlist with all of
- # the parent CanvasWindows, we should then use [wm stackorder .] to get
- # the rest of the CanvasWindows to make sure that all CanvasWindows are in
- # the menu. This would probably be better handled on the C side of
- # things, since then, the menu_windowlist could be built with the proper
- # parent/child relationships.
- # pdtk_post "Running pdtk_fixwindowmenu"
+# ------------------------------------------------------------------------------
+# parse command line args when Wish/pd-gui.tcl is started first
+
+proc parse_args {argc argv} {
+ opt_parser::init {
+ {-stderr set {::stderr}}
+ {-open lappend {- ::filestoopen_list}}
+ }
+ set unflagged_files [opt_parser::get_options $argv]
+ # if we have a single arg that is not a file, its a port or host:port combo
+ if {$argc == 1 && ! [file exists $argv]} {
+ if { [string is int $argv] && $argv > 0} {
+ # 'pd-gui' got the port number from 'pd'
+ set ::host "localhost"
+ set ::port $argv
+ } else {
+ set hostport [split $argv ":"]
+ set ::port [lindex $hostport 1]
+ if { [string is int $::port] && $::port > 0} {
+ set ::host [lindex $hostport 0]
+ } else {
+ set ::port 0
+ }
+
+ }
+ } elseif {$unflagged_files ne ""} {
+ foreach filename $unflagged_files {
+ lappend ::filestoopen_list $filename
+ }
+ }
+}
+
+proc open_filestoopen {} {
+ foreach filename $::filestoopen_list {
+ open_file $filename
+ }
}
# ------------------------------------------------------------------------------
@@ -374,83 +589,115 @@ proc singleton {key} {
}
proc singleton_request {offset maxbytes} {
- wm deiconify .pdwindow
- raise .pdwindow
+## the next 2 lines raise the focus to the given window (and change desktop)
+# wm deiconify .pdwindow
+# raise .pdwindow
return [tk appname]
}
proc first_lost {} {
- receive_args [selection get -selection PUREDATA]
- selection own -command first_lost -selection PUREDATA .
+ receive_args [selection get -selection ${::pdgui::scriptname} ]
+ selection own -command first_lost -selection ${::pdgui::scriptname} .
}
-# all other instances
-proc send_args {offset maxChars} {
- return [string range $::argv $offset [expr {$offset+$maxChars}]]
-}
-
proc others_lost {} {
set ::singleton_state "exit"
destroy .
exit
}
+# all other instances
+proc send_args {offset maxChars} {
+ set sendargs {}
+ foreach filename $::filestoopen_list {
+ lappend sendargs [file normalize $filename]
+ }
+ return [string range $sendargs $offset [expr {$offset+$maxChars}]]
+}
-# ------------------------------------------------------------------------------
-# various startup related procs
+# this command will open files received from a 2nd instance of Pd
+proc receive_args {filelist} {
+ raise .
+ wm deiconify .pdwindow
+ raise .pdwindow
+ foreach filename $filelist {
+ open_file $filename
+ }
+}
-proc check_for_running_instances {argc argv} {
- # pdtk_post "check_for_running_instances $argc $argv"
+proc dde_open_handler {cmd} {
+ open_file [file normalize $cmd]
+}
+
+proc check_for_running_instances { } {
switch -- $::windowingsystem {
"aqua" {
# handled by ::tk::mac::OpenDocument in apple_events.tcl
} "x11" {
# http://wiki.tcl.tk/1558
- if {![singleton PUREDATA_MANAGER]} {
- # other instances called by wish/pd-gui (exempt 'pd' by 5400 arg)
- if {$argc == 1 && [string is int $argv] && $argv >= 5400} {return}
- selection handle -selection PUREDATA . "send_args"
- selection own -command others_lost -selection PUREDATA .
+ # TODO replace PUREDATA name with path so this code is a singleton
+ # based on install location rather than this hard-coded name
+ if {![singleton ${::pdgui::scriptname}_MANAGER ]} {
+ # if pd-gui gets called from pd ('pd-gui 5400') or is told otherwise
+ # to connect to a running instance of Pd (by providing [<host>:]<port>)
+ # then we don't want to connect to a running instance
+ if { $::port > 0 && $::host ne "" } { return }
+ selection handle -selection ${::pdgui::scriptname} . "send_args"
+ selection own -command others_lost -selection ${::pdgui::scriptname} .
after 5000 set ::singleton_state "timeout"
vwait ::singleton_state
exit
} else {
# first instance
- selection own -command first_lost -selection PUREDATA .
+ selection own -command first_lost -selection ${::pdgui::scriptname} .
}
} "win32" {
- ## http://wiki.tcl.tk/1558
- # TODO on Win: http://tcl.tk/man/tcl8.4/TclCmd/dde.htm
+ ## http://wiki.tcl.tk/8940
+ package require dde ;# 1.4 or later needed for full unicode support
+ set topic "Pure_Data_DDE_Open"
+ # if no DDE service is running, start one and claim the name
+ if { [dde services TclEval $topic] == {} } {
+ dde servername -handler dde_open_handler $topic
+ }
}
}
}
-# this command will open files received from a 2nd instance of Pd
-proc receive_args args {
- # pdtk_post "receive_files $args"
- raise .
- foreach filename $args {
- open_file $filename
+
+# ------------------------------------------------------------------------------
+# load plugins on startup
+
+proc load_plugin_script {filename} {
+ global errorInfo
+
+ set basename [file tail $filename]
+ if {[lsearch $::loaded_plugins $basename] > -1} {
+ ::pdwindow::post [_ "'$basename' already loaded, ignoring: '$filename'\n"]
+ return
+ }
+
+ ::pdwindow::debug [_ "Loading plugin: $filename\n"]
+ set tclfile [open $filename]
+ set tclcode [read $tclfile]
+ close $tclfile
+ if {[catch {uplevel #0 $tclcode} errorname]} {
+ ::pdwindow::error "-----------\n"
+ ::pdwindow::error [_ "UNHANDLED ERROR: $errorInfo\n"]
+ ::pdwindow::error [_ "FAILED TO LOAD $filename\n"]
+ ::pdwindow::error "-----------\n"
+ } else {
+ lappend ::loaded_plugins $basename
}
}
-proc load_startup {} {
- global errorInfo
-# TODO search all paths for startup.tcl
- set startupdir [file normalize "$::sys_libdir/startup"]
- # pdtk_post "load_startup $startupdir"
- puts stderr "load_startup $startupdir"
- if { ! [file isdirectory $startupdir]} { return }
- foreach filename [glob -directory $startupdir -nocomplain -types {f} -- *.tcl] {
- puts "Loading $filename"
- set tclfile [open $filename]
- set tclcode [read $tclfile]
- close $tclfile
- if {[catch {uplevel #0 $tclcode} errorname]} {
- puts stderr "------------------------------------------------------"
- puts stderr "UNHANDLED ERROR: $errorInfo"
- puts stderr "FAILED TO LOAD $filename"
- puts stderr "------------------------------------------------------"
+proc load_startup_plugins {} {
+ foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
+ set dir [file normalize $pathdir]
+ if { ! [file isdirectory $dir]} {continue}
+ foreach filename [glob -directory $dir -nocomplain -types {f} -- \
+ *-plugin/*-plugin.tcl *-plugin.tcl] {
+ set ::current_plugin_loadpath [file dirname $filename]
+ load_plugin_script $filename
}
}
}
@@ -462,42 +709,27 @@ proc main {argc argv} {
set ::windowingsystem [tk windowingsystem]
tk appname pd-gui
load_locale
- check_for_running_instances $argc $argv
+ parse_args $argc $argv
+ check_for_running_instances
set_pd_paths
init_for_platform
- # post_tclinfo
- # set a timeout for how long 'pd-gui' should wait for 'pd' to start
- after 20000 set ::wait4pd "timeout"
- # TODO check args for -stderr and set pdtk_post accordingly
- if {$argc == 1 && [string is int $argv] && $argv >= 5400} {
+ # ::host and ::port are parsed from argv by parse_args
+ if { $::port > 0 && $::host ne "" } {
# 'pd' started first and launched us, so get the port to connect to
- ::pd_connect::to_pd [lindex $argv 0]
+ ::pd_connect::to_pd $::port $::host
} else {
# the GUI is starting first, so create socket and exec 'pd'
- set portnumber [::pd_connect::create_socket]
+ set ::port [::pd_connect::create_socket]
set pd_exec [file join [file dirname [info script]] ../bin/pd]
- exec -- $pd_exec -guiport $portnumber &
- }
- # wait for 'pd' to call pdtk_pd_startup, or exit on timeout
- vwait ::wait4pd
- if {$::wait4pd eq "timeout"} {
- puts stderr [_ "ERROR: 'pd' never showed up, 'pd-gui' quitting!"]
- exit 2
+ exec -- $pd_exec -guiport $::port &
+ if {$::windowingsystem eq "aqua"} {
+ # on Aqua, if 'pd-gui' first, then initial dir is home
+ set ::filenewdir $::env(HOME)
+ set ::fileopendir $::env(HOME)
+ }
}
- ::pd_bindings::class_bindings
- ::pd_menus::create_menubar
- ::pdtk_canvas::create_popup
- ::pdwindow::create_window
- ::pd_menus::configure_for_pdwindow
- load_startup
- # pdtk_post "------------------ done with main ----------------------"
+ ::pdwindow::verbose 0 "------------------ done with main ----------------------\n"
}
main $::argc $::argv
-
-
-
-
-
-
diff --git a/pd/tcl/pd.ico b/pd/tcl/pd.ico
new file mode 100755
index 0000000000000000000000000000000000000000..2da5c243623c9ea56b6faca91b5e687d2c4f62fb
GIT binary patch
literal 25214
zcmeHP30#)N);}r&DVu1x3xW%3E+B{?>&q$#xbK-;3TA>JzDTC1DWn-Uw@NKjGtE-l
z)Lbg?ws+g>wwLX7OS81Z>bvv(|MN1hF9?Z#cJurF?$n>>eV%8YnKLtIX3jZtjv@`@
z3hC3w3s)z}au!)9B7T0h`)?YG{2R}_ylnS@4Me`WLXcmO-&J;ah<G$*{;GRdk$tV1
z-*%tXSY(2~$?qpSI*UBp)#S%L^36&&`TZozNyKM@NFZoH6*3VZT{?jdlkk}kwp1*F
z|E0LtcEMl#1d64+yc{o-{$G^hF984X5&v9pvYwlAQHYCmiheO2f5YZlN8wUn<@1mb
zAFmc7EkJE-Tm$rzS0fjEz;B%Mt=2qb%(qT2uv({E&2v|!D)E1%D#QO}Wu?W)Tx@j-
z>5s>FsvlQYR+im_=lNx52A}Et$c-2Ics>V@nGpr(cX(XMa`IIvp72#^StZ}0{1TRb
z8noiB5*Kk{-DPFDEJr_Asu=V#17BEKPGznO>QaMU%5tU9flgHn^3k)NWv7MI;FCox
zN9DR$3st3fR-TqpJT&wxyp$9?SICd2c(oXhiuLnG3bdT4%CF1GW%<Q|O3}NTn##&$
z$Zu7-p6ZmKQY6$%`gOmlT%EtHB;KmasiMbP!i<g36=<?8yUw4h3vgvmROPR%WdB%8
zF;G^vteEw(eBGbLe1t+&<u6{S7o{m(j#yn>GWkNcsj~94PiR+;uV6?D^(VH^PM4OJ
zq9v%nYIP~GmJ}8O))H%eveoK?$1YY01)Ee$ECw%-_@jDqv4+(8!o?bI?OMQ*tDY83
z78%@7Q&#OoZdh=`hI!<G>M1WT)w<m!ua@UUMb<6n<}dDEgclvp$)DSG$MzlD{my+}
zw0-;btrO3E-WAVl%Rhr3^f@PgUK`X~WI5+~!->c~xli>*;jZCU|NFLf-G0t<@%Iyr
z8gF#>*ERq(@}1|_&IwgNPB6c(Qb&39th%}=RnGg%_<FR8K7BQGn=9H=*~r$wqg-{7
zj><xPEx*Lqv*qjJQBU=&?e6Sf?lXQsEMWGT;)b}XN?y1Uwp5ID3BRzf=nMYh=f&+a
zRs2(^CpOB&HE-1H={}*;eF~=A=5+xU46OS3@wqLLfr~F!6MzdwA(kNf!jAieXj7Sf
zqHOP7T+37mRw3jsV}5?0i=~|l67O@7TU7Bvl*95C=H?cbN!bZcu2=d!p5eVGE7b4H
ziWlO0yjS|Z4;I|hk_$SR-=z=~VqH7oiG4`l&&kDVe;Ug@h+=uA+=otE7h>bl^p{{U
zWnGo0(R8#fISf~wuuvm~<?^pRS+O2EJ{j5|Hs0ahHK411m_0L!%bQ`{?)bjR@}fM)
z_f3k5xXqa4ihIZR(h&C!@1@K3?f#DU0semd`k1eACFKscHGh)hj$%faW6!w|6eB<3
z@QurlD68DphGJZ6!o1Vh7-U8wpL+p*fZ_9U{5Fa22wN%!Q{xwyTVL=OKQD;Soxrxq
zVez?*tQ1Ttb6pEn2?UQ^*JR}i=_1!v3O%i0NY_Fu<p?lVVWkz%T}oADX=N#71#3x3
ziM80p#Wt!9^K8BAvK_)BQo|zKeM5iSy?%&4Y-@3Y^J59})dat-E_b@>VvC!Y(s6B2
z1zdXe>?tq5{IV1j6i8N9mN+>%N&oN&*|KGe{PUmxl=+KplBrXt3feELR;`kT4I4^E
zMus#C_m;5}Cd!Oixw3EHK6&GfH)O|-9dh4&_sNGJekga|d8fSl?z=K=+BEs~*I#8;
zUV&U`X)Q@dk~AR&^X5zH6Y0`AzP0oV>o3lIuaK1T6nW&4N5sR!L)rwlmz_Iz%DwmA
zE9=&+lUr7;k%0pTO47hoS-g0$ELwK6{B7MGGU(u7>ApNbx@C2jsoB@b_=%IHUAuM?
z^;WR-tLP!i|F&A(Vm-vKV@H`Zb(%D4)=0W^=^`UXj+E!0e_qCqA1|@5^p}KZV+B%-
zEMLA{9(w2@adUH%*Is)~9(?dY*}Z$Wj2$~x%i-SM-ZEkGRGBz&qD-DVS?;;#9(n7n
zw<PL~V2OS$L=GG{AoJ(Xm!za52@VOBCaE4WGdE9MU0r2y>2g`Re5K?<!f@;0E;rwL
zn^<0ql=$bPW#Ch((xI=v<j$EZasP;rcHw@qX8m2#x?elFp?I+b^$n4uM~}*<pMEOu
zzyH2`@WBW2@y8#_C!c%*J*JQJ3GOSw!NJnGb7$$)xr>Y#F+%q4-77D>^pae2%{B7b
zXP?REpMNfKFNaIgGx3u6tVKFR`^&03HpuEbH_9)+{354MpO&!x{iR?3a5-_}g#7s9
zk1~4nXbB7ql)!G?rCawN(xXQYiGML#x-IP_Pe1*%H0$Oq&3pSuSoi=**_S4%4`oXD
zfJljmjMDm6;=QR7yE9ErojN5y|NOHI9z0lv4I3stTm7W<&Q9|E_utF0W5=X@hYsTF
z>nmN>^^tDtf~EV$5IKJQxcu<L53=y45^3AEtvvbUlk%^B{Y$?4?mPM7i!bEMFTa$C
z=le*^t6>tlGghJ=Op*RCT_yA8&67==Hpy3CeI;Li{k44a%{TJxx8F+I;~6sOP^MTc
z7Kw{bl%Ib3Nlu<TDYve<UHbLwCtfYR#mC1-BKL<$_+gZLI8uK9{dZ}b-bR}C^AwL5
zcS(9WLB@=qAZ2UskPbaNN>lKO<)s0V@Is6%yX98NnmJ2ya&jbT1=_h`g7_{C6rT-#
zGIYc!NjZ`%1Ge`Um$uFlnAcl^Z;TMj3xlP3SW9Ua(?Ozcjgw{x9+H?mP*Qgfk?y6z
zGT_cg88&jXj2d^fc(-pM`PL%w{i>HVa%&``HcpnwkLO6nkYUnxl8^XJX(t_0{G|EP
zwi39?S6XasFMh$Dq<2uTM7^0NaSPI<gRh@N<|jze!bN%>{@H(Cee3Faq#lNh-pxXx
zrJpy2%&7Vx@~d^r&YxC4l`&C&kkzH?I}faLPEM_DsfjItH3tvQ%q)tFOB*$Myw13|
zD!;pTMR{py$^G~5*s*2v=H0t?9XfdMz~hfUv}gYHvwd2*Ht%*_RsMd~n{U23CMK<U
zh52C1md(3&?>eMEcnBZN^qJ*4)SiE7c~hjDZrV^+{yo>{=Cm4mr73@DDKanFxDoj)
zuw31L|NU5~u|Bba0|y>Q1vii&hy10k&6_uOEin~5RM_2R=&qF5h7VQc*95gVTmFQ`
z?(Xj6+?XFt9?_tKNczZU+{Y!N#kv9#<d7eB5)t<VTmC_JAosoQeA3J02SKwO@^5J*
zG9-4#h7Bmc;z^Mh*ZKRCMY_+|`Prp2b7uvfrKhPIHcDHI%jY+i<m<7^42CG?I0QKZ
z?fJ`@|L(y~y*h8MC~uCfuHyb3TUv^ESM?Ao06`A<+aNzv<2fl6KJM}W$GBIu{2-`C
z{(=VgqFbCdS44}nEWJMm7w@w?feKQq=vlP1oaHxc({w}^asOMzkjB#3!>J#t^L7}r
z`7=%aKK{1+H!WH6cahYJl9A&`8@Lep?PEOu`lRc6^SQiQmA_3>?=I3|5P0rErzb}x
zbg!O&&kafWJ9YjZ{^c$MM3y%o33GOF3`)yOOCT_K+qfD-%pvHU5Azrj^53n0uzwor
zF)Q71<vxflRrzhRU{B{?P5z2`jV3^DXp}f&$3|QJ9Pq^1{P+M&+WA-81n%Qp@xlu)
zv}x1E&ei3mhhmmTN3V?KG&^+YkZqU?N88#fTRrZ&%L6!QW&wC~2N?5!ZJO;$9Ca0w
zvvVIC+0Hkx-*#DZ9V*cCxGH~>&a+yzYUSFZXH_e2*$2U3<jB01*z*EgAYF;n4atRR
zh|8$VMoe)(RpmdH5$b$9maEXvjL49;$F{w;T58*N?AT^HRb|H|>lLpfuVTl}I{WAk
zel70p+p{P3zP8u;&Itd5eCE~oW?ugOAAEpa^1Ddisy;C9YPn|luNaV?j=itn*8iEi
z?CM%_RDTry*<<UEuDa&7Yr6ja?uplIV_rQ+^}FzPpMKKu+ck&Rev$p}AJ5b$|2HqT
z?=;2liJ-4Pe`jhv@_TwdzwqS`JNfwq-I-mV{6CzUG&%ldRuS~`)AcAHdo(^+zz_Pq
zUa$PaEz>4VUWh8{lmAH6$uNHKCaUQ8eHD*a@4{+#SrHNahYf$k^2V+4AGMo4vD&*@
zZ^qp7<=(JisNz}AN2k}Cqx!=!$KU_Q>HZHtSLV6>x8mxrYP}1n-1JL8)W=aTy|?YY
z>Pk$l+2vZu(I#Dt;kx!xFY+mMCC7Av<@o;BZgsKtteSSJn)i-<&EME|9PC!EdK8PD
z^u_kaK~HsR<|KtT7HhpF`t=aGs#kAGhAx?YaEPQI7^?Ndm8;fDYHF&arlm=qb)J@$
z<6nq|eifs2ytr4wrJ!iO%)Q}8t;?=ny;@Q#Qe<HHKrOdtU!NmaTycd!929Iz^5Tmx
zYJH$(%a%gD4}z3neb+iIm{`V*8>e;D2OfAp`UC|@5cDtV$Jih={S6v4(7Ni9B}-(^
zoH;TFIyUue>chYN_M6s0M~xa~*XO7&zxUpITJL`6op-bz?CI$#ci(-t)@L?u+$eY5
zb(ahpG)U6Z(*+xy*54;gn4on$?4w#wvb+SH^2I2vFFp0tQ(7Nx-@d)pSEo#wBDdUf
zi>zF^QeJuG6?yg5SGB%+<Bd0pv$L~cmy>`Iou%XOE?WOw3mtUs+_^FrmLXb)(x9`a
zJ~>Fz4rfT?#*Jmcf(3S6k#>aegeVD5j+Vsd;<TP=bX3{|KKke*x%Jjt1tPMnSg}Ie
z6waJEBWpL@EwRu`srMEZ76S9M4mWAiB)eW}^w*<RI&frUq(nzYOL%y=3>Yv#cJ10F
zd-m)R*vlmi{WEY-hNNX=La+3d4$v*1c;X4W4jTPNUu_@A$C%{efGaOAPxA8fB_A00
zRGL5{&~|~TSu<q%b=OPKq96%b)K3Nv86rc54wa!phuQVk^z;l#hdm@CGgI3P+}%Co
zig0)F4ENM_0jss}9G%tZwMPHkuwjGDo;_QJ4<8P_eWYDqEkM5;9TtWp=@8!$LY|-W
z4GEEueqqo>6U8zb{CjnV^h+2Z;e(<j0=l>V)Ijmi>8AD6h#ZT=6eVlBM8~WBrOW7U
zl9ipUbyT;Wo`Qn}iG}{0mNrP*kMxt^$GS?d2f_s+kM!u-OWRMVA5-6LX7P}gncm_)
z+FKrd^ier-<cK6DCW_lMZ}GnNO7ULMM*RK#C3bhLv_v0vDF~2|!u}Ep`_65*ua};i
zI!VuU(A75u$*@tQW%%eZGIrZEX|)f}d-st{*anuDt&*Jlx#GK^tHkU|(>5lD6``)5
zKY}l6OP|_4Xz>bc54ELV?$(=nSv2NwH`toCB0;0V4E+^~z%6b~yK6goTNX2V|Gw<3
zy^r0u?cs->I9&eJqmSH_7qR;QjzvY@g20~paLxCNbNWZx-rq5IZt=oZ`}b#O!zS~X
zDPZxE@TfcV_jkO$taRy!RVd)G>ECS}_;yK!u3%B#fc5(Q`Y-+Eqdt6phos%*C*#KO
z{iBO>!h>w@twSZ86+GN-+V00X^!R9-jlw0f``X`^ew}jj{u~*S{n%cA^L|mzMBDq2
zp_1x{1JS)5uWG+HvzP7tQ;#mrJ^Oz4T#F>FDv+43cgjcinJ$<N9ZO_==unwG_i_1X
z^}hIJ$#47F-!HlWXX{dU=grYF*cU1Xn~?qR-#&WG^x=)S<Nbs?ze;G@G;!GS)qKBT
ztekzn;&+z6VARNwGafEpsNcU65YYQRd_OxgGvl^SdVCHB26pv{Lm%r5=wc4imBVA>
z;}1^Y_b+t`>-_5$ta0<_@7XhH(vwfZRJQKD?O})dJ<Zohx57qNclz!26Pq@*ZsYz*
z9a&aBa}0~&nG<!0G}rv&-&g;A{E=5rUswD06JCD*`wiE+{_xt&I^O^DR3qnBQ(WGB
zp^o<rywk6Lw&m2#AJ_i=ng&kI26@eLzNc~R@8!Xt*1TKf+31ZI>v;dKZ$DV;H1GJy
z=jwR>P30G#eZK2|K7788_f24?WUAx!c^*?%IC|NfJJ{ruSjr|QImjtDuPl@0K*78s
znOj&S@$vDJkdPoSQVG{^sI+qU@L|0V;!sQ5o4FTq-=|#{79A~982jtc;Ui=i_5@@1
zH2Wa!?Qg#MrhQMN4LArg$h9-ClW8+%%H3P;mAkiYlTE;!xrH(Z`%r<#Jjob5L^835
zaqsLOF+khcx4~|o%DoJ7MLzP=F3Wvt_M8ITTlL<}0W@}3vv(QW>RqUBD{S?~4sG@=
z?jw{_Xj`T|9gDQwcH3>TcI{gD+xSVRPMsupNr?1Y5+UpF*(!rU*N|buu@{bz_3PJb
zxrcju;<Is()dp(WYwENty=TS4=Gtv}Ckb5HOTyNNN#vRsZCj`8v|`0A`dp&JEbK|w
z`AT3xZ&`)&g0*+9*P}-JKIN6{**TJpL$VcRx5<jzRtx1M@8Z@HP})H(i&JI7q$v^|
zXORWBEHk71-|K&Spng3tH?F4->_<b9hIIEA88#_(K=Y8kEu#`522O?vuJ`bfkuBP~
zH0zZR(b@|}zS!9#+BYB6^r|sY@!?_6j;8u0HEwrZ{3Q2id;rC0s$a_>H&@?ukLZN>
zHr+(h5-rZ217<pVw8RHczo#_0BDq6kfA6-fQoKio;>2}qaKr4*ojV1@WHrcv(X^mv
zpB}jmq)*StoHNVee%h$f6FWNGUpsF6HP<`b=jC5L0k*%o64&WVcW&vYt10eWS8e(^
zcYkhbE&wID%MGN9^l2#tSI0yp5nhKv4=G=u6TsG9E+9RAKr4V!9NS?McRbSG4gjM`
z3NQ>9aT#GaXh{Pi0Jeo~Fyp|!r{qc#=~$o;C<RtrMpzD7ZUiO+IAM@BfHS~E`Z+Fq
zeiN`A*asZEjPN*Uc@S6%WCH$xO?VP<!fz^77T|k;f^)6N%*<5T+1U!d3Dq!t`gG+8
z_!%ez*l3gid>51>VE<5#z!|=Rok8I|U*Viw;jmJ{CqTirqi}|=V9%)lZKD7z(0YBr
zMbl5-j|YwcwbG7n6?`KU&X^VCC57{J4ajy1=h_;Ou@r$ba0Qu51LxZc@}36HtrcV}
z4V+~w$W<CR`&N*}6wdS&d;%0?GX)!qf(=RG{6#@FRNJ;~Q&3Bu27RLeY!K(tkF$$o
z@D)%v=eGkkDMi4>r66Z&`p?$}(r?;8`b`^1e{F3b{f=#bT&Q3lQjmca<TnMMih9ux
z|CM9xTiB5_;HN@g9R+z)1AYg8I{h36jsa|43Vs=S4BmeGZ3SPL^Y%aKCto<y3||Zd
zV}*tz{Tu_sL%bRu;??v&ucrTN8w2u?;UmW}fL>weA?PBShhQ73H~pl?@Ev)Ne8YS4
zx?>w^n+K!=b`b?X9|hx!9((dX^aTYU9R)dE^9tudUG#Gv)Z`(Y6xW-6*x#5}!FFp0
ze0CIcm2>EKYy*xS6~<7()@xq_U@KPe0aEZK;rgLi4s^U~^SHJ#aO5G50d&E7)6ccA
z<~qc>;UrKe{qP}BnE&?gVBc2o!O`t^EQ{s9=jy!lJMs|c@rBS&zJ;CHP7D016m0N%
zZ6yB~9%A1UoC_9<#h#z*71s^&0epWHoEYryplj;qj_auDf3BxB*CEbh(hr+pz5Ac*
z56%<pb&_Z6n#ZJ{bi&@Q^FtTa>xbD3c;y~t#(;B!^P#qNv?l##FW@=^-?e(tPkL(7
z4<9W}!;Bd-6wWUc?7ez#GW!7Mx1o>x&*xl+%w7inKl^*`frft52FH2q*apKx+zT#*
zei&@4^}nIbT;c7bVDwY3zy7+WmF1JK`5wpX_O;ZE!J<WrE{cA$4v~jox2Sjj*Q6hQ
zd<u3GJs%y{7T9d;<IuHhS38Y3L(qEz$ADuGA4mH;)Bk1+9Opqzd4hYH83Xtg{Sp1`
z(RT@E|E)<s&Xp9OabG)l@SwsumZpb&4!=P?2Aty@7mfkvf|2#$ziFqP?@0fJ>}6&Q
za2`|_{nTYT07;<#IQhRO{hYs)AvlK#xJcM(V!x2zxwpZltZ-&%e@A)=_^{faInr;&
zptgBn_G8k|c?>^P(*F#~qmBZDfHVQ9dr=SY15ynAI8Us`|2W&T_dn}5{ZC#(Jej7S
z?dHA>ze+7*b3IK?PF6UdQ@7uK`$f}lc<AAWA13|Jg3j?k55Nte4n{qI`ar6oALlL#
z_CR}`aKBN#d-ql~d4Y47eOPlpU^`5EI4<xVwwJYk|Nc7V>blk;jsbj;4gC{9D}98F
z4oN#h05HhV&-D`bb;7JaoENq2XQZEN4`nX+uPVyqro2C*-^fI@&EqQipF=qlfnI<o
zK;4miM4edEPhN(fu)-O&f^V{d|Ee80uhy~)<s8ySxwJ0&x$Zd16DVJ|;e7Nvw!zE+
z@(}kN@DJ&q1W;G^0;oHZe)3OJuU@^5k$(8;+QGR%nDxi#0)Mn0v;R3K;ryk@dt6%y
z_&aMEw5D#xyar}Y*IZY*Z)08iJLnt(kbg)&*B<ge_1`ee%kN-wS8zSm;2KDndzM*W
z`V9}6{xrO8bOW}*=mw;jfWN!ebKy6k2>96B!Mz6S^#RbC43J;k0ro%FpJsqR_NcG9
zUzqjT^aZcvVeW(V(QVA!WgBYh$A3gW^?dR<<u%I8)PD)ef|Nhe|2sh^dA}vVc}xB$
z_}dF-{a<pvaUHJ-oT(_vF_Z(jo*1xPg8Bu)IZIIABdB*1I8WB#+GarghS<D$v%b>C
zK>Gt_UjxoLf_4b#BX@yL+6ZZHBkyqiB>m(e&SxGPE(LA|_5*tXW5-%v^}H0<Wxx_(
zAy5Pq0JDMIiv&ZB@_{)3%bHsST8IgAPa73!CGDh}`xmd=3t9u*7s3Gxuo5861A!EP
ze3t|y0&zeDz_H}sP5vVvvb>8)h7QBeE+~W`tptCweA3N4>~~WapV5BU6^IA8KW78?
z0rvvz8-o37`uIBho&;n7Apqqkj;SdVKQAird&3j#*P3vo+f=}|wE;o_+J-n*?Ds=e
zScfaI)&XVsy%@*>I3{d6`H$uQrxWKcdB6gY=6?Wh17BC+16&>PKJMQIUIz{WBLMP|
zH^Bb-Pp2lR&<{vQ?1w_!ib9NxLOh5<ERAyWbytY1QSR;CRqLR33UM0>u_Oxd9;!uv
z&k1~Y4G;v72mdPiJEHE4E8|)##IPvDv#3^<)(Y_|3UNRRu{H{^KngJ}s&!a9g_skC
zSQX{dtu^VN2m}N4KH=Q@Pbc=jroTmeD}^{4g%}@|RGz5d52z4}r4XB@5G$nMTc{9=
zqY$5?5YwZs?B43KqTegLxoQ^CTp?CTA*M?qK1m_YNWrI3!B0=YPfw*E9IOzBr4UP|
zT6AxDS<#O;CWW{qWqBz|!B0~qJR7Imko@-~mBKbW1ztMLu^6ln+oT%1IbT-vgO5~?
z6`d5~>d=Nr1%FeO@EqFkOuW)<sN$!zC(~8;>>iYdF9-U$ev<#wNq@KH{wn6RP=z>1
z1s_ahdC@i&hM$tjPZg;uFsqv*{ak-IfB%a0$E^PY8+kh^#J;KMxBA-J@G9EyGTH!s
zLQI~5AF6FEjwGoziEWg#x9bm}c^vRpuK#BLwKR?MRPM1JDzu`9ih46h!M9l<o)Kd~
zej1<<YYBdeRfro@EiG-7SML_bLHl4J5by&2iv8EfKcP)iJr&|O72*~ZVlP$XTR|%7
zjp}28cuLhAYZPKMm1l47??H16!2SDD$Ui9Nf)o3Ub$4l!=AjTzsSu;75Z|c~H>tvo
zT%{0Kst^OJ5a+7A!ka0?qhfs0lt+;FxA^WVpcz2<@UKeTH`_ReUZD`@sSr=A5cjEE
zf}1F(W{nhLOqG+DlS168LJX=xT&+S}t!fhBMj44`my~h;3f@7r_Qd|n0SYbvQ;_#^
zpdDoVH~keoP|iwS;A_My{!JEM1pi*bWpTy7-k|BYBv()EPX#qg9YuS2W%~23zPkKk
z20<Z}ON_qO{KJjM4~PXC=wBkm+=*&Wln=OHdjQlI|17Y4+7!5^Gys^mzEMV@tU?>Y
zz&{ZwC_4%W0N7q8(!#wW3!rUd&7X+XD0?9=2=D>e2V5t^fcJo70A&XaoDUs`z0VHV
z{f;{#B_-v!0nP-DI|4SV;{;+qj>EtCxW!^Q9v2sPJRl(88<am4plyTovma>NISFuH
z*unF0+HH;9&)EFT`Ju5@8hfI#Y0}PZ&TDx_!gD;@`{*yiGkny+zV-#|^~3+?B=gcg
zfS|7o?Un!6`gulR&Wh>lP*?r4X3aWD8>q2^(hhCTFGvGzo`j=62m9fCePGVHXm_W*
z6LCznwx9LWevf!5g;*(t*eQkhFFOrp3|J@PxfEh}6zrnfABtxIv;)I;y_ye_83WpW
zIR>=7B7UmY`ccM7+VbgNKpuckxIR-hePHUZqF<lK()NkCJDndfY1%ehlLttH83XnK
z&o62lf7Z|QZTfn#e&($?2IL3C{qej(^Ah_4@qhY^nDlZi9M9|=`H(zC-z(Z|>r+3+
z0CPtnZcm>PlLyF0qz(S(nip6<`GI|QzWO-^{JzS6;vD{G`*{{(+K)Ivd*8B7#N_F^
z=(j@u7y4bWZp031zm~e{H+{e{;GC+X{)n3Ov#&T85YMRF%yVw?0)1pi56>#uKlF>>
zJ?rNg!1>k!#3wR;HsA|z{!_+}V*NZ1GVM3@^UNIYb@@EkA|E2YQqL2d>*+Hv@?d@H
z=NKS%k>$+<`~mKJ+>>Ha|0((cm@{FXY0@_c?=*PcT5~RNJs?jac2U<)elTY&b@3t3
zF;FJu>COQ41MamJ){j^{g}70D#=~<So;gi{j|tDn&6%F#ddM>g<DbIz*Qb8OUb6n#
z0BytE``G>n%;l3j_vD#0!LxO?#hkC#RzJ^Ej1MP$k2wC0?dKShKM9^+BfeAnf1<u?
zfldJH=l&Cbww~Y_jycDnpALP59M|L8XfW$B+s^tO*JJ!!SPF5p3bDDGXUI2*-(>qO
z0QX<^KjDt^#82U$^fS)Ge#QCX&uM9CKVvL@#(c2@YsV=9YnTSs(o+Q1L=EgMrwnjL
zdkXvSDeTXu5L$3*$dDmF1E(;LenNfRd%5qE|EQ-^{^<rp0GoigD#YL#34{RT7uv!}
zFXzqqV9I7a>|@$f3Es0#zGoSH*9FJ~$d`wJ8>&!*>pb9kAOj!`%wOMRXrzqi2tGH-
z9Y6X3n}Nf?r@*rgcm}^o(+Yt7Kz_ZHiSsWG@wf`HtO_yJ3h}!N@zn~kyb7_oYV5XY
zs#*Ky&mkYjhxspMVtE$C0xQJ!D#Yc&woQ8~Y{IZ>BQ{qdHdr<5*n;&B0P2?FFODi*
zzgtgFg_vJ$pQcTewrRwX!!A8UAs!j$9A1BF{f%KGMC?CoX;C(N;L|ocKkeg)>*k#O
zv+5^5#o^yB&~`oASGA28c5ZDShD{Q&<q9)}JV`nEQjb6Np>V{bE5u$a#JwxTdTSdm
z?bM0SSrlTzm7Bju1@cix;(WQ3$pwW4A}(AZK3pNTT;bp4Ltntw40}1^!xiGem3ud@
zeaPnvaQ(QHiR*$7;?osk%oXC+6=K*GV%Qbp^A%#u6=L00lTL0sk&k`F{Fgd$EldNr
z#?^)1c;~oo;r9Q3Dn7f9T$;wX{JW9R4ssq8+sq_2{=HB?O+zeqxN{R_g#h5H3qTL#
zr5%+#!|NWP0{@y@1$>e!AV1oHeYt{wFOf#~?%gXO6I4LXU50Ns=Q?5^KSSRu`kPY@
zr9Mo#gE9x@UZeX^=b^qqeGfiDkK$Xd*&VlS+ja)=vUYuf@*{n85qGS8Rp^UCe;|HO
zS(W}WkQwaX!$0K=bq~r#lto!T{qd+9Q2%3W4QZgvPv0!+e4yF>J$ww$ApThUtimRs
z<4-8RGe6r!KO@Smh6c6)@{;*Jz<kfPQZ_|wwAMN4gM%1hts9u{StfN3e7_fMryV|U
z&6+i5D5ugt5b@SpA7wvM*5o~P3)7FL4fvk^GFJlaL0=`}vK8X9wOmShkn%9~8v6aP
zFDZXACV}^q=OKgLUsZpT(9qB_=yi`lw_cA}qT3O(R0{d+2A~KsToGiqBJ@Mim@#AK
zL;hZXe?xU4e0-DfJvoy6Qv#5ldw}&oIzU;fw#2o<alHsce6vCvwL%=VLfo=)Z{@iN
zdFs2K1|mip`*R%5zXvMBQLDyHoiF73&WN+tdkbQ+6=JbfV~@u3Q9sxJ`Xq0}Tr0#}
t<1Dh1LOi!>;_o&EA703M+y(i&I)LkWJrixJ=SPE+O2N!r4gB|a{}(hVmSF$@
literal 0
HcmV?d00001
diff --git a/pd/tcl/pd_bindings.tcl b/pd/tcl/pd_bindings.tcl
index 0cef04742..a1c4c57af 100644
--- a/pd/tcl/pd_bindings.tcl
+++ b/pd/tcl/pd_bindings.tcl
@@ -4,83 +4,99 @@ package require pd_menucommands
package require dialog_find
namespace eval ::pd_bindings:: {
- variable modifier
-
- namespace export window_bindings
+ namespace export global_bindings
namespace export dialog_bindings
- namespace export canvas_bindings
+ namespace export patch_bindings
}
-# the commands are bound using "" quotations so that the $mytoplevel is
+# TODO rename pd_bindings to window_bindings after merge is done
+
+# Some commands are bound using "" quotations so that the $mytoplevel is
# interpreted immediately. Since the command is being bound to $mytoplevel,
# it makes sense to have value of $mytoplevel already in the command. This is
-# the opposite of the menu commands in pd_menus.tcl
+# the opposite of most menu/bind commands here and in pd_menus.tcl, which use
+# {} to force execution of any variables (i.e. $::focused_window) until later
+
-# binding by class is not recursive, so its useful for certain things
+# binding by class is not recursive, so its useful for window events
proc ::pd_bindings::class_bindings {} {
# and the Pd window is in a class to itself
- bind PdWindow <Configure> "::pd_bindings::window_configure %W"
bind PdWindow <FocusIn> "::pd_bindings::window_focusin %W"
- # bind to all the canvas windows
- bind CanvasWindow <Map> "::pd_bindings::map %W"
- bind CanvasWindow <Unmap> "::pd_bindings::unmap %W"
- bind CanvasWindow <Configure> "::pd_bindings::window_configure %W"
- bind CanvasWindow <FocusIn> "::pd_bindings::window_focusin %W"
- # bindings for dialog windows, which behave differently than canvas windows
+ # bind to all the windows dedicated to patch canvases
+ bind PatchWindow <FocusIn> "::pd_bindings::window_focusin %W"
+ bind PatchWindow <Map> "::pd_bindings::map %W"
+ bind PatchWindow <Unmap> "::pd_bindings::unmap %W"
+ bind PatchWindow <Configure> "::pd_bindings::patch_configure %W %w %h %x %y"
+ # dialog panel windows bindings, which behave differently than PatchWindows
bind DialogWindow <Configure> "::pd_bindings::dialog_configure %W"
bind DialogWindow <FocusIn> "::pd_bindings::dialog_focusin %W"
}
-proc ::pd_bindings::window_bindings {mytoplevel} {
- variable modifier
-
- # for key bindings
- if {$::windowingsystem eq "aqua"} {
- set modifier "Mod1"
- } else {
- set modifier "Control"
- }
-
- # File menu
- bind $mytoplevel <$modifier-Key-b> "menu_helpbrowser"
- bind $mytoplevel <$modifier-Key-f> "::dialog_find::menu_find_dialog $mytoplevel"
- bind $mytoplevel <$modifier-Key-n> "menu_new"
- bind $mytoplevel <$modifier-Key-o> "menu_open"
- bind $mytoplevel <$modifier-Key-p> "menu_print $mytoplevel"
- bind $mytoplevel <$modifier-Key-q> "pdsend \"pd verifyquit\""
- bind $mytoplevel <$modifier-Key-r> "menu_raise_pdwindow"
- bind $mytoplevel <$modifier-Shift-Key-L> "menu_clear_console"
- bind $mytoplevel <$modifier-Shift-Key-Q> "pdsend \"pd quit\""
- bind $mytoplevel <$modifier-Shift-Key-R> "menu_toggle_console"
-
- # DSP control
- bind $mytoplevel <$modifier-Key-slash> "pdsend \"pd dsp 1\""
- bind $mytoplevel <$modifier-Key-period> "pdsend \"pd dsp 0\""
-}
-
-proc ::pd_bindings::pdwindow_bindings {mytoplevel} {
- variable modifier
-
- window_bindings $mytoplevel
-
- # TODO update this to work with the console, if it is used
- bind $mytoplevel <$modifier-Key-a> ".pdwindow.text tag add sel 1.0 end"
- bind $mytoplevel <$modifier-Key-x> "tk_textCut .pdwindow.text"
- bind $mytoplevel <$modifier-Key-c> "tk_textCopy .pdwindow.text"
- bind $mytoplevel <$modifier-Key-v> "tk_textPaste .pdwindow.text"
- bind $mytoplevel <$modifier-Key-w> "wm iconify $mytoplevel"
+proc ::pd_bindings::global_bindings {} {
+ # we use 'bind all' everywhere to get as much of Tk's automatic binding
+ # behaviors as possible, things like not sending an event for 'O' when
+ # 'Control-O' is pressed.
+ bind all <$::modifier-Key-a> {menu_send %W selectall}
+ bind all <$::modifier-Key-b> {menu_helpbrowser}
+ bind all <$::modifier-Key-c> {menu_send %W copy}
+ bind all <$::modifier-Key-d> {menu_send %W duplicate}
+ bind all <$::modifier-Key-e> {menu_toggle_editmode}
+ bind all <$::modifier-Key-f> {menu_find_dialog}
+ bind all <$::modifier-Key-g> {menu_send %W findagain}
+ bind all <$::modifier-Key-n> {menu_new}
+ bind all <$::modifier-Key-o> {menu_open}
+ bind all <$::modifier-Key-p> {menu_print $::focused_window}
+ bind all <$::modifier-Key-q> {pdsend "pd verifyquit"}
+ bind all <$::modifier-Key-r> {menu_raise_pdwindow}
+ bind all <$::modifier-Key-s> {menu_send %W menusave}
+ bind all <$::modifier-Key-v> {menu_send %W paste}
+ bind all <$::modifier-Key-w> {menu_send_float %W menuclose 0}
+ bind all <$::modifier-Key-x> {menu_send %W cut}
+ bind all <$::modifier-Key-z> {menu_undo}
+ bind all <$::modifier-Key-1> {menu_send_float %W obj 0}
+ bind all <$::modifier-Key-2> {menu_send_float %W msg 0}
+ bind all <$::modifier-Key-3> {menu_send_float %W floatatom 0}
+ bind all <$::modifier-Key-4> {menu_send_float %W symbolatom 0}
+ bind all <$::modifier-Key-5> {menu_send_float %W text 0}
+ bind all <$::modifier-Key-slash> {pdsend "pd dsp 1"}
+ bind all <$::modifier-Key-period> {pdsend "pd dsp 0"}
+ bind all <$::modifier-greater> {menu_raisenextwindow}
+ bind all <$::modifier-less> {menu_raisepreviouswindow}
+ # annoying, but Tk's bind needs uppercase letter to get the Shift
+ bind all <$::modifier-Shift-Key-B> {menu_send %W bng}
+ bind all <$::modifier-Shift-Key-C> {menu_send %W mycnv}
+ bind all <$::modifier-Shift-Key-D> {menu_send %W vradio}
+ bind all <$::modifier-Shift-Key-H> {menu_send %W hslider}
+ bind all <$::modifier-Shift-Key-I> {menu_send %W hradio}
+ bind all <$::modifier-Shift-Key-L> {menu_clear_console}
+ bind all <$::modifier-Shift-Key-N> {menu_send %W numbox}
+ bind all <$::modifier-Shift-Key-Q> {pdsend "pd quit"}
+ bind all <$::modifier-Shift-Key-S> {menu_send %W menusaveas}
+ bind all <$::modifier-Shift-Key-T> {menu_send %W toggle}
+ bind all <$::modifier-Shift-Key-U> {menu_send %W vumeter}
+ bind all <$::modifier-Shift-Key-V> {menu_send %W vslider}
+ bind all <$::modifier-Shift-Key-W> {menu_send_float %W menuclose 1}
+ bind all <$::modifier-Shift-Key-Z> {menu_redo}
+
+ # OS-specific bindings
if {$::windowingsystem eq "aqua"} {
- bind $mytoplevel <$modifier-Key-m> "menu_minimize $mytoplevel"
- bind $mytoplevel <$modifier-Key-t> "menu_font_dialog $mytoplevel"
- bind $mytoplevel <$modifier-quoteleft> "menu_raisenextwindow"
+ # Cmd-m = Minimize and Cmd-t = Font on Mac OS X for all apps
+ bind all <$::modifier-Key-m> {menu_minimize %W}
+ bind all <$::modifier-Key-t> {menu_font_dialog}
+ bind all <$::modifier-quoteleft> {menu_raisenextwindow}
+ bind all <$::modifier-Shift-Key-M> {menu_message_dialog}
} else {
- bind $mytoplevel <$modifier-Key-m> "menu_message_dialog"
- bind $mytoplevel <$modifier-Key-t> "menu_texteditor"
+ bind all <$::modifier-Key-m> {menu_message_dialog}
+ #bind all <$::modifier-Key-t> {menu_texteditor}
+ bind all <$::modifier-Next> {menu_raisenextwindow} ;# PgUp
+ bind all <$::modifier-Prior> {menu_raisepreviouswindow};# PageDown
}
- # Tcl event bindings
- wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
+ bind all <KeyPress> {::pd_bindings::sendkey %W 1 %K %A 0}
+ bind all <KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 0}
+ bind all <Shift-KeyPress> {::pd_bindings::sendkey %W 1 %K %A 1}
+ bind all <Shift-KeyRelease> {::pd_bindings::sendkey %W 0 %K %A 1}
}
# this is for the dialogs: find, font, sendmessage, gatom properties, array
@@ -89,135 +105,115 @@ proc ::pd_bindings::pdwindow_bindings {mytoplevel} {
proc ::pd_bindings::dialog_bindings {mytoplevel dialogname} {
variable modifier
- window_bindings $mytoplevel
-
bind $mytoplevel <KeyPress-Escape> "dialog_${dialogname}::cancel $mytoplevel"
bind $mytoplevel <KeyPress-Return> "dialog_${dialogname}::ok $mytoplevel"
- bind $mytoplevel <$modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
+ bind $mytoplevel <$::modifier-Key-w> "dialog_${dialogname}::cancel $mytoplevel"
+ # these aren't supported in the dialog, so alert the user, then break so
+ # that no other key bindings are run
+ bind $mytoplevel <$::modifier-Key-s> {bell; break}
+ bind $mytoplevel <$::modifier-Shift-Key-S> {bell; break}
+ bind $mytoplevel <$::modifier-Key-p> {bell; break}
- $mytoplevel configure -padx 10 -pady 5
- wm group $mytoplevel .
- wm resizable $mytoplevel 0 0
wm protocol $mytoplevel WM_DELETE_WINDOW "dialog_${dialogname}::cancel $mytoplevel"
- catch { # not all platforms/Tcls versions have these options
- wm attributes $mytoplevel -topmost 1
- #wm attributes $mytoplevel -transparent 1
- #$mytoplevel configure -highlightthickness 1
- }
}
-proc ::pd_bindings::canvas_bindings {mytoplevel} {
+proc ::pd_bindings::patch_bindings {mytoplevel} {
variable modifier
- set mycanvas $mytoplevel.c
-
- window_bindings $mytoplevel
+ set tkcanvas [tkcanvas_name $mytoplevel]
- # key bindings -------------------------------------------------------------
- bind $mytoplevel <$modifier-Key-1> "pdsend \"$mytoplevel obj\""
- bind $mytoplevel <$modifier-Key-2> "pdsend \"$mytoplevel msg\""
- bind $mytoplevel <$modifier-Key-3> "pdsend \"$mytoplevel floatatom\""
- bind $mytoplevel <$modifier-Key-4> "pdsend \"$mytoplevel symbolatom\""
- bind $mytoplevel <$modifier-Key-5> "pdsend \"$mytoplevel text\""
- bind $mytoplevel <$modifier-Key-a> "pdsend \"$mytoplevel selectall\""
- bind $mytoplevel <$modifier-Key-c> "pdsend \"$mytoplevel copy\""
- bind $mytoplevel <$modifier-Key-d> "pdsend \"$mytoplevel duplicate\""
- bind $mytoplevel <$modifier-Key-e> "pdsend \"$mytoplevel editmode 0\""
- bind $mytoplevel <$modifier-Key-g> "pdsend \"$mytoplevel findagain\""
- bind $mytoplevel <$modifier-Key-s> "pdsend \"$mytoplevel menusave\""
- bind $mytoplevel <$modifier-Key-v> "pdsend \"$mytoplevel paste\""
- bind $mytoplevel <$modifier-Key-w> "pdsend \"$mytoplevel menuclose 0\""
- bind $mytoplevel <$modifier-Key-x> "pdsend \"$mytoplevel cut\""
- bind $mytoplevel <$modifier-Key-z> "menu_undo $mytoplevel"
+ # TODO move mouse bindings to global and bind to 'all'
- # annoying, but Tk's bind needs uppercase letter to get the Shift
- bind $mytoplevel <$modifier-Shift-Key-B> "pdsend \"$mytoplevel bng 1\""
- bind $mytoplevel <$modifier-Shift-Key-C> "pdsend \"$mytoplevel mycnv 1\""
- bind $mytoplevel <$modifier-Shift-Key-D> "pdsend \"$mytoplevel vradio 1\""
- bind $mytoplevel <$modifier-Shift-Key-H> "pdsend \"$mytoplevel hslider 1\""
- bind $mytoplevel <$modifier-Shift-Key-I> "pdsend \"$mytoplevel hradio 1\""
- bind $mytoplevel <$modifier-Shift-Key-N> "pdsend \"$mytoplevel numbox 1\""
- bind $mytoplevel <$modifier-Shift-Key-S> "pdsend \"$mytoplevel menusaveas\""
- bind $mytoplevel <$modifier-Shift-Key-T> "pdsend \"$mytoplevel toggle 1\""
- bind $mytoplevel <$modifier-Shift-Key-U> "pdsend \"$mytoplevel vumeter 1\""
- bind $mytoplevel <$modifier-Shift-Key-V> "pdsend \"$mytoplevel vslider 1\""
- bind $mytoplevel <$modifier-Shift-Key-W> "pdsend \"$mytoplevel menuclose 1\""
- bind $mytoplevel <$modifier-Shift-Key-Z> "menu_redo $mytoplevel"
-
- if {$::windowingsystem eq "aqua"} {
- bind $mytoplevel <$modifier-Key-m> "menu_minimize $mytoplevel"
- bind $mytoplevel <$modifier-Key-t> "menu_font_dialog $mytoplevel"
- bind $mytoplevel <$modifier-quoteleft> "menu_raisenextwindow"
- } else {
- bind $mytoplevel <$modifier-Key-m> "menu_message_dialog"
- bind $mytoplevel <$modifier-Key-t> "menu_texteditor"
+ # mouse bindings -----------------------------------------------------------
+ # these need to be bound to $tkcanvas because %W will return $mytoplevel for
+ # events over the window frame and $tkcanvas for events over the canvas
+ bind $tkcanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
+ bind $tkcanvas <$::modifier-Motion> "pdtk_canvas_motion %W %x %y 2"
+ bind $tkcanvas <ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 0"
+ bind $tkcanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
+ bind $tkcanvas <$::modifier-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 2"
+ bind $tkcanvas <Shift-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 1"
+
+ if {$::windowingsystem eq "x11"} {
+ # from http://wiki.tcl.tk/3893
+ bind all <Button-4> \
+ {event generate [focus -displayof %W] <MouseWheel> -delta 1}
+ bind all <Button-5> \
+ {event generate [focus -displayof %W] <MouseWheel> -delta -1}
+ bind all <Shift-Button-4> \
+ {event generate [focus -displayof %W] <Shift-MouseWheel> -delta 1}
+ bind all <Shift-Button-5> \
+ {event generate [focus -displayof %W] <Shift-MouseWheel> -delta -1}
}
- bind $mytoplevel <KeyPress> "::pd_bindings::sendkey %W 1 %K %A 0"
- bind $mytoplevel <KeyRelease> "::pd_bindings::sendkey %W 0 %K %A 0"
- bind $mytoplevel <Shift-KeyPress> "::pd_bindings::sendkey %W 1 %K %A 1"
- bind $mytoplevel <Shift-KeyRelease> "::pd_bindings::sendkey %W 0 %K %A 1"
+ bind $tkcanvas <MouseWheel> {::pdtk_canvas::scroll %W y %D}
+ bind $tkcanvas <Shift-MouseWheel> {::pdtk_canvas::scroll %W x %D}
- # mouse bindings -----------------------------------------------------------
- # these need to be bound to $mycanvas because %W will return $mytoplevel for
- # events over the window frame and $mytoplevel.c for events over the canvas
- bind $mycanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
- bind $mycanvas <$modifier-Motion> "pdtk_canvas_motion %W %x %y 2"
- bind $mycanvas <ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 0"
- bind $mycanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
- bind $mycanvas <$modifier-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 2"
- # TODO look into "virtual events' for a means for getting Shift-Button, etc.
+ # "right clicks" are defined differently on each platform
switch -- $::windowingsystem {
"aqua" {
- bind $mycanvas <ButtonPress-2> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-2> "pdtk_canvas_rightclick %W %x %y %b"
# on Mac OS X, make a rightclick with Ctrl-click for 1 button mice
- bind $mycanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
- # TODO try replacing the above with this
- #bind all <Control-Button-1> {event generate %W <Button-2> \
- # -x %x -y %y -rootx %X -rooty %Y \
- # -button 2 -time %t}
+ bind $tkcanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <Option-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "x11" {
- bind $mycanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
# on X11, button 2 "pastes" from the X windows clipboard
- bind $mycanvas <ButtonPress-2> "pdtk_canvas_clickpaste %W %x %y %b"
+ bind $tkcanvas <ButtonPress-2> "pdtk_canvas_clickpaste %W %x %y %b"
+ bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
} "win32" {
- bind $mycanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
+ bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
}
}
- #TODO bind $mytoplevel <MouseWheel>
# window protocol bindings
wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"$mytoplevel menuclose 0\""
- bind $mycanvas <Destroy> "::pd_bindings::window_destroy %W"
+ bind $tkcanvas <Destroy> "::pd_bindings::window_destroy %W"
}
#------------------------------------------------------------------------------#
# event handlers
-proc ::pd_bindings::window_configure {mytoplevel} {
- pdtk_canvas_getscroll $mytoplevel
+proc ::pd_bindings::patch_configure {mytoplevel width height x y} {
+ # for some reason, when we create a window, we get an event with a
+ # widthXheight of 1x1 first, then we get the right values, so filter it out
+ if {$width == 1 && $height == 1} {return}
+ pdtk_canvas_getscroll [tkcanvas_name $mytoplevel]
+ # send the size/location of the window and canvas to 'pd' in the form of:
+ # left top right bottom
+ pdsend "$mytoplevel setbounds $x $y [expr $x + $width] [expr $y + $height]"
}
-proc ::pd_bindings::window_destroy {mycanvas} {
- set mytoplevel [winfo toplevel $mycanvas]
+proc ::pd_bindings::window_destroy {window} {
+ set mytoplevel [winfo toplevel $window]
unset ::editmode($mytoplevel)
+ unset ::editingtext($mytoplevel)
+ unset ::loaded($mytoplevel)
+ # unset my entries all of the window data tracking arrays
+ array unset ::windowname $mytoplevel
+ array unset ::parentwindows $mytoplevel
+ array unset ::childwindows $mytoplevel
}
# do tasks when changing focus (Window menu, scrollbars, etc.)
proc ::pd_bindings::window_focusin {mytoplevel} {
- # pdtk_post "::pd_bindings::window_focusin $mytoplevel"
+ # focused_window is used throughout for sending bindings, menu commands,
+ # etc. to the correct patch receiver symbol.
set ::focused_window $mytoplevel
- ::dialog_find::set_canvas_to_search $mytoplevel
- ::pd_menucommands::set_menu_new_dir $mytoplevel
+ ::dialog_find::set_window_to_search $mytoplevel
+ ::pd_menucommands::set_filenewdir $mytoplevel
::dialog_font::update_font_dialog $mytoplevel
if {$mytoplevel eq ".pdwindow"} {
::pd_menus::configure_for_pdwindow
} else {
::pd_menus::configure_for_canvas $mytoplevel
}
- # TODO handle enabling/disabling the Undo and Redo menu items in Edit
+ if {[winfo exists .font]} {wm transient .font $::focused_window}
+ # if we regain focus from another app, make sure to editmode cursor is right
+ if {$::editmode($mytoplevel)} {
+ $mytoplevel configure -cursor hand2
+ }
# TODO handle enabling/disabling the Cut/Copy/Paste menu items in Edit
- # TODO enable menu items that the Pd window or dialogs might have disabled
- # TODO update "Open Recent" menu
}
proc ::pd_bindings::dialog_configure {mytoplevel} {
@@ -233,6 +229,7 @@ proc ::pd_bindings::dialog_focusin {mytoplevel} {
# don't get a final "unmap" event when we destroy the window.
proc ::pd_bindings::map {mytoplevel} {
pdsend "$mytoplevel map 1"
+ ::pdtk_canvas::finished_loading_file $mytoplevel
}
proc ::pd_bindings::unmap {mytoplevel} {
@@ -243,7 +240,11 @@ proc ::pd_bindings::unmap {mytoplevel} {
#------------------------------------------------------------------------------#
# key usage
-proc ::pd_bindings::sendkey {mycanvas state key iso shift} {
+# canvas_key() expects to receive the patch's mytoplevel because key messages
+# are local to each patch. Therefore, key messages are not send for the
+# dialog panels, the Pd window, help browser, etc. so we need to filter those
+# events out.
+proc ::pd_bindings::sendkey {window state key iso shift} {
# TODO canvas_key on the C side should be refactored with this proc as well
switch -- $key {
"BackSpace" { set iso ""; set key 8 }
@@ -257,7 +258,13 @@ proc ::pd_bindings::sendkey {mycanvas state key iso shift} {
if {$iso ne ""} {
scan $iso %c key
}
- puts "::pd_bindings::sendkey {%W:$mycanvas $state %K$key %A$iso $shift}"
- # $mycanvas might be a toplevel, but [winfo toplevel] does the right thing
- pdsend "[winfo toplevel $mycanvas] key $state $key $shift"
+ # some pop-up panels also bind to keys like the enter, but then disappear,
+ # so ignore their events. The inputbox in the Startup dialog does this.
+ if {! [winfo exists $window]} {return}
+ #$window might be a toplevel or canvas, [winfo toplevel] does the right thing
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel key $state $key $shift"
+ }
+ # TODO send to 'pd key' for global key events in Pd?
}
diff --git a/pd/tcl/pd_connect.tcl b/pd/tcl/pd_connect.tcl
index cdd3d91db..4fa136dd7 100644
--- a/pd/tcl/pd_connect.tcl
+++ b/pd/tcl/pd_connect.tcl
@@ -3,6 +3,7 @@ package provide pd_connect 0.1
namespace eval ::pd_connect:: {
variable pd_socket
+ variable cmds_from_pd ""
namespace export to_pd
namespace export create_socket
@@ -12,18 +13,17 @@ namespace eval ::pd_connect:: {
# TODO figure out how to escape { } properly
proc ::pd_connect::configure_socket {sock} {
- fconfigure $sock -blocking 0 -buffering line -encoding utf-8;
- fileevent $sock readable {::pd_connect::pd_readsocket ""}
+ fconfigure $sock -blocking 0 -buffering none -encoding utf-8;
+ fileevent $sock readable {::pd_connect::pd_readsocket}
}
# if pd opens first, it starts pd-gui, then pd-gui connects to the port pd sent
-proc ::pd_connect::to_pd {port} {
- # puts "::pd_connect::to_pd"
+proc ::pd_connect::to_pd {port {host localhost}} {
variable pd_socket
- # puts stderr "Connecting to localhost $port ..."
- if {[catch {set pd_socket [socket localhost $port]}]} {
- puts stderr "WARNING: connect to pd failed, retrying port $port."
- after 1000 ::pd_connect::to_pd $port
+ ::pdwindow::debug "'pd-gui' connecting to 'pd' on localhost $port ...\n"
+ if {[catch {set pd_socket [socket $host $port]}]} {
+ puts stderr "WARNING: connect to pd failed, retrying port $host:$port."
+ after 1000 ::pd_connect::to_pd $port $host
return
}
::pd_connect::configure_socket $pd_socket
@@ -40,15 +40,15 @@ proc ::pd_connect::create_socket {} {
}
proc ::pd_connect::from_pd {channel clientaddr clientport} {
- puts "::pd_connect::from_pd"
variable pd_socket $channel
- puts "Connection from $clientaddr:$clientport registered"
+ ::pdwindow::debug "Connection from 'pd' to 'pd-gui' on $clientaddr:$clientport\n"
::pd_connect::configure_socket $pd_socket
}
# send a pd/FUDI message from Tcl to Pd. This function aims to behave like a
-# [; message( in Pd. Basically, whatever is in quotes after the proc name
-# will be sent as if it was sent from a message box with a leading semi-colon
+# [; message( in Pd or pdsend on the command line. Basically, whatever is in
+# quotes after the proc name will be sent as if it was sent from a message box
+# with a leading semi-colon.
proc ::pd_connect::pdsend {message} {
variable pd_socket
append message \;
@@ -58,35 +58,39 @@ proc ::pd_connect::pdsend {message} {
}
}
-proc ::pd_connect::pd_readsocket {cmd_from_pd} {
- variable pd_socket
- if {[eof $pd_socket]} {
- # if we lose the socket connection, that means pd quit, so we quit
- close $pd_socket
- exit
- }
- append cmd_from_pd [read $pd_socket]
- while {![info complete $cmd_from_pd] || \
- [string index $cmd_from_pd end] ne "\n"} {
- append cmd_from_pd [read $pd_socket]
- if {[eof $pd_socket]} {
- close $pd_socket
- exit
- }
- }
-# puts stderr [concat CMD: $cmd_from_pd :CMD]
- if {[catch {uplevel #0 $cmd_from_pd} errorname]} {
- global errorInfo
- puts stderr "errorname: >>$errorname<<"
- switch -regexp -- $errorname {
- "missing close-brace" {
- # TODO consider using [info complete $cmd_from_pd] in a loop
- pd_readsocket $cmd_from_pd
- } "^invalid command name" {
- puts stderr "INVALID COMMAND NAME: $errorInfo"
- } default {
- puts stderr "UNHANDLED ERROR: $errorInfo"
- }
- }
- }
+proc ::pd_connect::pd_readsocket {} {
+ variable pd_socket
+ variable cmds_from_pd
+ if {[eof $pd_socket]} {
+ # if we lose the socket connection, that means pd quit, so we quit
+ close $pd_socket
+ exit
+ }
+ append cmds_from_pd [read $pd_socket]
+ if {[string index $cmds_from_pd end] ne "\n" || \
+ ![info complete $cmds_from_pd]} {
+ # the block is incomplete, wait for the next block of data
+ return
+ } else {
+ set docmds $cmds_from_pd
+ set cmds_from_pd ""
+ if {![catch {uplevel #0 $docmds} errorname]} {
+ # we ran the command block without error, reset the buffer
+ } else {
+ # oops, error, alert the user:
+ global errorInfo
+ switch -regexp -- $errorname {
+ "missing close-brace" {
+ ::pdwindow::fatal \
+ [concat [_ "(Tcl) MISSING CLOSE-BRACE '\}': "] $errorInfo "\n"]
+ } "^invalid command name" {
+ ::pdwindow::fatal \
+ [concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo "\n"]
+ } default {
+ ::pdwindow::fatal \
+ [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo "\n"]
+ }
+ }
+ }
+ }
}
diff --git a/pd/tcl/pd_guiprefs.tcl b/pd/tcl/pd_guiprefs.tcl
new file mode 100644
index 000000000..2423441ee
--- /dev/null
+++ b/pd/tcl/pd_guiprefs.tcl
@@ -0,0 +1,249 @@
+#
+# Copyright (c) 1997-2009 Miller Puckette.
+# Copyright (c) 2011 Yvan Volochine.
+#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
+
+package provide pd_guiprefs 0.1
+
+
+namespace eval ::pd_guiprefs:: {
+ namespace export init
+ namespace export write_recentfiles
+ namespace export update_recentfiles
+}
+
+# FIXME should these be globals ?
+set ::recentfiles_key ""
+set ::recentfiles_domain ""
+
+
+#################################################################
+# global procedures
+#################################################################
+# ------------------------------------------------------------------------------
+# init preferences
+#
+proc ::pd_guiprefs::init {} {
+ switch -- $::windowingsystem {
+ "aqua" { init_aqua }
+ "win32" { init_win }
+ "x11" { init_x11 }
+ }
+ # assign gui preferences
+ # osx special case for arrays
+ set arr [expr { $::windowingsystem eq "aqua" }]
+ set ::recentfiles_list ""
+ catch {set ::recentfiles_list [get_config $::recentfiles_domain \
+ $::recentfiles_key $arr]}
+}
+
+proc ::pd_guiprefs::init_aqua {} {
+ # osx has a "Open Recent" menu with 10 recent files (others have 5 inlined)
+ set ::recentfiles_domain org.puredata
+ set ::recentfiles_key "NSRecentDocuments"
+ set ::total_recentfiles 10
+}
+
+proc ::pd_guiprefs::init_win {} {
+ # windows uses registry
+ set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pure-Data"
+ set ::recentfiles_key "RecentDocs"
+}
+
+proc ::pd_guiprefs::init_x11 {} {
+ # linux uses ~/.config/pure-data dir
+ set ::recentfiles_domain "~/.config/pure-data"
+ set ::recentfiles_key "recentfiles.conf"
+ prepare_configdir
+}
+
+# ------------------------------------------------------------------------------
+# write recent files
+#
+proc ::pd_guiprefs::write_recentfiles {} {
+ write_config $::recentfiles_list $::recentfiles_domain $::recentfiles_key true
+}
+
+# ------------------------------------------------------------------------------
+# this is called when opening a document (wheredoesthisshouldgo.tcl)
+#
+proc ::pd_guiprefs::update_recentfiles {afile} {
+ # remove duplicates first
+ set index [lsearch -exact $::recentfiles_list $afile]
+ set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
+ # insert new one in the beginning and crop the list
+ set ::recentfiles_list [linsert $::recentfiles_list 0 $afile]
+ set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles]
+ ::pd_menus::update_recentfiles_menu
+}
+
+#################################################################
+# main read/write procedures
+#################################################################
+
+# ------------------------------------------------------------------------------
+# get configs from a file or the registry
+#
+proc ::pd_guiprefs::get_config {adomain {akey} {arr}} {
+ switch -- $::windowingsystem {
+ "aqua" { set conf [get_config_aqua $adomain $akey $arr] }
+ "win32" { set conf [get_config_win $adomain $akey $arr] }
+ "x11" { set conf [get_config_x11 $adomain $akey $arr] }
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# write configs to a file or to the registry
+# $arr is true if the data needs to be written in an array
+#
+proc ::pd_guiprefs::write_config {data {adomain} {akey} {arr false}} {
+ switch -- $::windowingsystem {
+ "aqua" { write_config_aqua $data $adomain $akey $arr }
+ "win32" { write_config_win $data $adomain $akey $arr }
+ "x11" { write_config_x11 $data $adomain $akey }
+ }
+}
+
+#################################################################
+# os specific procedures
+#################################################################
+
+# ------------------------------------------------------------------------------
+# osx: read a plist file
+#
+proc ::pd_guiprefs::get_config_aqua {adomain {akey} {arr false}} {
+ if {![catch {exec defaults read $adomain $akey} conf]} {
+ if {$arr} {
+ set conf [plist_array_to_tcl_list $conf]
+ }
+ } else {
+ # initialize NSRecentDocuments with an empty array
+ exec defaults write $adomain $akey -array
+ set conf {}
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# win: read in the registry
+#
+proc ::pd_guiprefs::get_config_win {adomain {akey} {arr false}} {
+ package require registry
+ if {![catch {registry get $adomain $akey} conf]} {
+ return [expr {$conf}]
+ } else {
+ return {}
+ }
+}
+
+# ------------------------------------------------------------------------------
+# linux: read a config file and return its lines splitted.
+#
+proc ::pd_guiprefs::get_config_x11 {adomain {akey} {arr false}} {
+ set filename [file join $adomain $akey]
+ set conf {}
+ if {
+ [file exists $filename] == 1
+ && [file readable $filename]
+ } {
+ set fl [open $filename r]
+ while {[gets $fl line] >= 0} {
+ lappend conf $line
+ }
+ close $fl
+ }
+ return $conf
+}
+
+# ------------------------------------------------------------------------------
+# osx: write configs to plist file
+# if $arr is true, we write an array
+#
+proc ::pd_guiprefs::write_config_aqua {data {adomain} {akey} {arr false}} {
+ # FIXME empty and write again so we don't loose the order
+ if {[catch {exec defaults write $adomain $akey -array} errorMsg]} {
+ ::pdwindow::error "write_config_aqua $akey: $errorMsg"
+ }
+ if {$arr} {
+ foreach filepath $data {
+ set escaped [escape_for_plist $filepath]
+ exec defaults write $adomain $akey -array-add "$escaped"
+ }
+ } else {
+ set escaped [escape_for_plist $data]
+ exec defaults write $adomain $akey '$escaped'
+ }
+}
+
+# ------------------------------------------------------------------------------
+# win: write configs to registry
+# if $arr is true, we write an array
+#
+proc ::pd_guiprefs::write_config_win {data {adomain} {akey} {arr false}} {
+ package require registry
+ # FIXME: ugly
+ if {$arr} {
+ if {[catch {registry set $adomain $akey $data multi_sz} errorMsg]} {
+ ::pdwindow::error "write_config_win $data $akey: $errorMsg"
+ }
+ } else {
+ if {[catch {registry set $adomain $akey $data sz} errorMsg]} {
+ ::pdwindow::error "write_config_win $data $akey: $errorMsg"
+ }
+ }
+}
+
+# ------------------------------------------------------------------------------
+# linux: write configs to USER_APP_CONFIG_DIR
+#
+proc ::pd_guiprefs::write_config_x11 {data {adomain} {akey}} {
+ # right now I (yvan) assume that data are just \n separated, i.e. no keys
+ set data [join $data "\n"]
+ set filename [file join $adomain $akey]
+ if {[catch {set fl [open $filename w]} errorMsg]} {
+ ::pdwindow::error "write_config_x11 $data $akey: $errorMsg"
+ } else {
+ puts -nonewline $fl $data
+ close $fl
+ }
+}
+
+#################################################################
+# utils
+#################################################################
+
+# ------------------------------------------------------------------------------
+# linux only! : look for pd config directory and create it if needed
+#
+proc ::pd_guiprefs::prepare_configdir {} {
+ if {[file isdirectory $::recentfiles_domain] != 1} {
+ file mkdir $::recentfiles_domain
+ ::pdwindow::debug "$::recentfiles_domain was created.\n"
+ }
+}
+
+# ------------------------------------------------------------------------------
+# osx: handles arrays in plist files (thanks hc)
+#
+proc ::pd_guiprefs::plist_array_to_tcl_list {arr} {
+ set result {}
+ set filelist $arr
+ regsub -all -- {("?),\s+("?)} $filelist {\1 \2} filelist
+ regsub -all -- {\n} $filelist {} filelist
+ regsub -all -- {^\(} $filelist {} filelist
+ regsub -all -- {\)$} $filelist {} filelist
+ regsub -line -- {^'(.*)'$} $filelist {\1} filelist
+
+ foreach file $filelist {
+ set filename [regsub -- {,$} $file {}]
+ lappend result $filename
+ }
+ return $result
+}
+
+# the Mac OS X 'defaults' command uses single quotes to quote things,
+# so they need to be escaped
+proc ::pd_guiprefs::escape_for_plist {str} {
+ return [regsub -all -- {'} $str {\\'}]
+}
diff --git a/pd/tcl/pd_menucommands.tcl b/pd/tcl/pd_menucommands.tcl
index e1373b84c..91f562f37 100644
--- a/pd/tcl/pd_menucommands.tcl
+++ b/pd/tcl/pd_menucommands.tcl
@@ -3,8 +3,6 @@ package provide pd_menucommands 0.1
namespace eval ::pd_menucommands:: {
variable untitled_number "1"
- variable menu_new_dir [pwd]
- variable menu_open_dir [pwd]
namespace export menu_*
}
@@ -14,27 +12,25 @@ namespace eval ::pd_menucommands:: {
proc ::pd_menucommands::menu_new {} {
variable untitled_number
- variable menu_new_dir
- if { ! [file isdirectory $menu_new_dir]} {set menu_new_dir $::env(HOME)}
- set untitled_name [_ "Untitled"]
- pdsend "pd filename $untitled_name-$untitled_number [enquote_path $menu_new_dir]"
- pdsend "#N canvas"
- pdsend "#X pop 1"
+ if { ! [file isdirectory $::filenewdir]} {set ::filenewdir $::env(HOME)}
+ # to localize "Untitled" there will need to be changes in g_canvas.c and
+ # g_readwrite.c, where it tests for the string "Untitled"
+ set untitled_name "Untitled"
+ pdsend "pd menunew $untitled_name-$untitled_number [enquote_path $::filenewdir]"
incr untitled_number
}
proc ::pd_menucommands::menu_open {} {
- variable menu_open_dir
- if { ! [file isdirectory $menu_open_dir]} {set menu_open_dir $::env(HOME)}
+ if { ! [file isdirectory $::fileopendir]} {set ::fileopendir $::env(HOME)}
set files [tk_getOpenFile -defaultextension .pd \
-multiple true \
-filetypes $::filetypes \
- -initialdir $menu_open_dir]
+ -initialdir $::fileopendir]
if {$files ne ""} {
foreach filename $files {
open_file $filename
}
- set menu_open_dir [file dirname $filename]
+ set ::fileopendir [file dirname $filename]
}
}
@@ -43,54 +39,83 @@ proc ::pd_menucommands::menu_print {mytoplevel} {
-defaultextension .ps \
-filetypes { {{postscript} {.ps}} }]
if {$filename ne ""} {
- $mytoplevel.c postscript -file $filename
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ $tkcanvas postscript -file $filename
}
}
-# dialog types:
-# global (only one): find, sendmessage, prefs, helpbrowser
-# per-canvas: font, canvas properties (created with a message from pd)
-# per object: gatom, iemgui, array, data structures (created with a message from pd)
+# ------------------------------------------------------------------------------
+# functions called from Edit menu
+
+proc ::pd_menucommands::menu_undo {} {
+ if {$::focused_window eq $::undo_toplevel && $::undo_action ne "no"} {
+ pdsend "$::focused_window undo"
+ }
+}
+
+proc ::pd_menucommands::menu_redo {} {
+ if {$::focused_window eq $::undo_toplevel && $::redo_action ne "no"} {
+ pdsend "$::focused_window redo"
+ }
+}
+
+proc ::pd_menucommands::menu_editmode {state} {
+ if {[winfo class $::focused_window] ne "PatchWindow"} {return}
+ set ::editmode_button $state
+# this shouldn't be necessary because 'pd' will reply with pdtk_canvas_editmode
+# set ::editmode($::focused_window) $state
+ pdsend "$::focused_window editmode $state"
+}
+proc ::pd_menucommands::menu_toggle_editmode {} {
+ menu_editmode [expr {! $::editmode_button}]
+}
# ------------------------------------------------------------------------------
-# functions called from Edit menu
+# generic procs for sending menu events
-proc menu_undo {mytoplevel} {
- # puts stderr "menu_undo $mytoplevel not implemented yet"
+# send a message to a pd canvas receiver
+proc ::pd_menucommands::menu_send {window message} {
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel $message"
+ } elseif {$mytoplevel eq ".pdwindow"} {
+ if {$message eq "copy"} {
+ tk_textCopy .pdwindow.text
+ } elseif {$message eq "selectall"} {
+ .pdwindow.text tag add sel 1.0 end
+ } elseif {$message eq "menusaveas"} {
+ ::pdwindow::save_logbuffer_to_file
+ }
+ }
}
-proc menu_redo {mytoplevel} {
- # puts stderr "menu_redo $mytoplevel not implemented yet"
+# send a message to a pd canvas receiver with a float arg
+proc ::pd_menucommands::menu_send_float {window message float} {
+ set mytoplevel [winfo toplevel $window]
+ if {[winfo class $mytoplevel] eq "PatchWindow"} {
+ pdsend "$mytoplevel $message $float"
+ }
}
# ------------------------------------------------------------------------------
# open the dialog panels
proc ::pd_menucommands::menu_message_dialog {} {
- if {[winfo exists .send_message]} {
- wm deiconify .send_message
- raise .message
- } else {
- # TODO insert real message panel here
- toplevel .send_message
- wm group .send_message .
- wm title .send_message [_ "Send Message..."]
- wm resizable .send_message 0 0
- ::pd_bindings::dialog_bindings .send_message "send_message"
- frame .send_message.frame
- label .send_message.label -text [_ "Message"] -width 30 -height 15
- pack .send_message.label .send_message.frame -side top -expand yes -fill both
- }
+ ::dialog_message::open_message_dialog $::focused_window
+}
+
+proc ::pd_menucommands::menu_find_dialog {} {
+ ::dialog_find::open_find_dialog $::focused_window
}
-proc ::pd_menucommands::menu_font_dialog {mytoplevel} {
+proc ::pd_menucommands::menu_font_dialog {} {
if {[winfo exists .font]} {
raise .font
- } elseif {$mytoplevel eq ".pdwindow"} {
+ } elseif {$::focused_window eq ".pdwindow"} {
pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1]
} else {
- pdsend "$mytoplevel menufont"
+ pdsend "$::focused_window menufont"
}
}
@@ -110,20 +135,27 @@ proc ::pd_menucommands::menu_startup_dialog {} {
}
}
+proc ::pd_menucommands::menu_helpbrowser {} {
+ ::helpbrowser::open_helpbrowser
+}
+
+proc ::pd_menucommands::menu_texteditor {} {
+ ::pdwindow::error "the text editor is not implemented"
+}
+
# ------------------------------------------------------------------------------
# window management functions
-proc ::pd_menucommands::menu_minimize {mytoplevel} {
- wm iconify $mytoplevel
+proc ::pd_menucommands::menu_minimize {window} {
+ wm iconify [winfo toplevel $window]
}
-proc ::pd_menucommands::menu_maximize {mytoplevel} {
- wm state $mytoplevel zoomed
+proc ::pd_menucommands::menu_maximize {window} {
+ wm state [winfo toplevel $window] zoomed
}
-proc menu_raise_pdwindow {} {
- set top_window [lindex [wm stackorder .pdwindow] end]
- if {.pdwindow eq $top_window} {
+proc ::pd_menucommands::menu_raise_pdwindow {} {
+ if {$::focused_window eq ".pdwindow" && [winfo viewable .pdwindow]} {
lower .pdwindow
} else {
wm deiconify .pdwindow
@@ -131,62 +163,89 @@ proc menu_raise_pdwindow {} {
}
}
+# used for cycling thru windows of an app
+proc ::pd_menucommands::menu_raisepreviouswindow {} {
+ lower [lindex [wm stackorder .] end] [lindex [wm stackorder .] 0]
+ focus [lindex [wm stackorder .] end]
+}
+
+# used for cycling thru windows of an app the other direction
+proc ::pd_menucommands::menu_raisenextwindow {} {
+ set mytoplevel [lindex [wm stackorder .] 0]
+ raise $mytoplevel
+ focus $mytoplevel
+}
+
+# ------------------------------------------------------------------------------
+# Pd window functions
+proc menu_clear_console {} {
+ ::pdwindow::clear_console
+}
+
# ------------------------------------------------------------------------------
# manage the saving of the directories for the new commands
# this gets the dir from the path of a window's title
-proc ::pd_menucommands::set_menu_new_dir {mytoplevel} {
- variable menu_new_dir
- variable menu_open_dir
+proc ::pd_menucommands::set_filenewdir {mytoplevel} {
# TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
if {$mytoplevel eq ".pdwindow"} {
- # puts "set_menu_new_dir $mytoplevel"
- set menu_new_dir $menu_open_dir
+ set ::filenewdir $::fileopendir
} else {
- regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored menu_new_dir
+ regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored ::filenewdir
}
}
-# ------------------------------------------------------------------------------
-# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
-proc ::pd_menucommands::menu_doc_open {subdir basename} {
- set dirname "$::sys_libdir/$subdir"
-
- switch -- [string tolower [file extension $basename]] {
- ".txt" {::pd_menucommands::menu_opentext "$dirname/$basename"
- } ".c" {::pd_menucommands::menu_opentext "$dirname/$basename"
- } ".htm" {::pd_menucommands::menu_openhtml "$dirname/$basename"
- } ".html" {::pd_menucommands::menu_openhtml "$dirname/$basename"
- } default {
- pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
+# parse the textfile for the About Pd page
+proc ::pd_menucommands::menu_aboutpd {} {
+ set versionstring "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION$::PD_TEST_VERSION"
+ set filename "$::sys_libdir/doc/1.manual/1.introduction.txt"
+ if {[winfo exists .aboutpd]} {
+ wm deiconify .aboutpd
+ raise .aboutpd
+ } else {
+ toplevel .aboutpd -class TextWindow
+ wm title .aboutpd [_ "About Pd"]
+ wm group .aboutpd .
+ .aboutpd configure -menu $::dialog_menubar
+ text .aboutpd.text -relief flat -borderwidth 0 \
+ -yscrollcommand ".aboutpd.scroll set" -background white
+ scrollbar .aboutpd.scroll -command ".aboutpd.text yview"
+ pack .aboutpd.scroll -side right -fill y
+ pack .aboutpd.text -side left -fill both -expand 1
+ bind .aboutpd <$::modifier-Key-w> "wm withdraw .aboutpd"
+
+ set textfile [open $filename]
+ while {![eof $textfile]} {
+ set bigstring [read $textfile 1000]
+ regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2
+ regsub -all PD_VERSION $bigstring2 $versionstring bigstring3
+ .aboutpd.text insert end $bigstring3
}
+ close $textfile
}
}
-# open text docs in a Pd window
-proc ::pd_menucommands::menu_opentext {filename} {
- global pd_myversion
- set mytoplevel [format ".help%d" [clock seconds]]
- toplevel $mytoplevel -class TextWindow
- text $mytoplevel.text -relief flat -borderwidth 0 \
- -yscrollcommand "$mytoplevel.scroll set" -background white
- scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview"
- pack $mytoplevel.scroll -side right -fill y
- pack $mytoplevel.text -side left -fill both -expand 1
- ::pd_bindings::window_bindings $mytoplevel
-
- set textfile [open $filename]
- while {![eof $textfile]} {
- set bigstring [read $textfile 1000]
- regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2
- regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3
- $mytoplevel.text insert end $bigstring3
+# ------------------------------------------------------------------------------
+# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
+proc ::pd_menucommands::menu_doc_open {dir basename} {
+ if {[file pathtype $dir] eq "relative"} {
+ set dirname "$::sys_libdir/$dir"
+ } else {
+ set dirname $dir
+ }
+ set textextension "[string tolower [file extension $basename]]"
+ if {[lsearch -exact [lindex $::filetypes 0 1] $textextension] > -1} {
+ set fullpath [file normalize [file join $dirname $basename]]
+ set dirname [file dirname $fullpath]
+ set basename [file tail $fullpath]
+ pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
+ } else {
+ ::pd_menucommands::menu_openfile "$dirname/$basename"
}
- close $textfile
}
# open HTML docs from the menu using the OS-default HTML viewer
-proc ::pd_menucommands::menu_openhtml {filename} {
+proc ::pd_menucommands::menu_openfile {filename} {
if {$::tcl_platform(os) eq "Darwin"} {
exec sh -c [format "open '%s'" $filename]
} elseif {$::tcl_platform(platform) eq "windows"} {
diff --git a/pd/tcl/pd_menus.tcl b/pd/tcl/pd_menus.tcl
index 99b6be94d..1d4862c19 100644
--- a/pd/tcl/pd_menus.tcl
+++ b/pd/tcl/pd_menus.tcl
@@ -4,33 +4,18 @@
package provide pd_menus 0.1
package require pd_menucommands
-package require Tk
-#package require tile
-## replace Tk widgets with Ttk widgets on 8.5
-#namespace import -force ttk::*
# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
-# TODO figure out parent window/window list for Window menu
-# TODO what is the Tcl package constructor or init()?
-# TODO $::pd_menus::menubar or .menubar globally?
# since there is one menubar that is used for all windows, the menu -commands
# use {} quotes so that $::focused_window is interpreted when the menu item
# is called, not when the command is mapped to the menu item. This is the
# opposite of the 'bind' commands in pd_bindings.tcl
-
-# ------------------------------------------------------------------------------
-# global variables
-
-# TODO this should properly be inside the pd_menus namespace, now it is global
-namespace import ::pd_menucommands::*
-
namespace eval ::pd_menus:: {
variable accelerator
variable menubar ".menubar"
- variable current_toplevel ".pdwindow"
-
+
namespace export create_menubar
namespace export configure_for_pdwindow
namespace export configure_for_canvas
@@ -52,32 +37,33 @@ proc ::pd_menus::create_menubar {} {
}
menu $menubar
set menulist "file edit put find media window help"
- if { $::windowingsystem eq "aqua" } {create_apple_menu $menubar}
- # FIXME why does the following (if uncommented) kill my menubar?
- # if { $::windowingsystem eq "win32" } {create_system_menu $menubar}
foreach mymenu $menulist {
menu $menubar.$mymenu
$menubar add cascade -label [_ [string totitle $mymenu]] \
-menu $menubar.$mymenu
- [format build_%s_menu $mymenu] $menubar.$mymenu .
- if {$::windowingsystem eq "win32"} {
- # fix menu font size on Windows with tk scaling = 1
- $menubar.$mymenu configure -font menufont
- }
+ [format build_%s_menu $mymenu] $menubar.$mymenu
}
+ if {$::windowingsystem eq "aqua"} {create_apple_menu $menubar}
+ if {$::windowingsystem eq "win32"} {create_system_menu $menubar}
+ . configure -menu $menubar
}
proc ::pd_menus::configure_for_pdwindow {} {
variable menubar
# these are meaningless for the Pd window, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
+ # File menu
+ $menubar.file entryconfigure [_ "Save"] -state disabled
+ $menubar.file entryconfigure [_ "Save As..."] -state normal
+ $menubar.file entryconfigure [_ "Print..."] -state disabled
+ $menubar.file entryconfigure [_ "Close"] -state disabled
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state disabled
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
+ pdtk_canvas_editmode .pdwindow 0
+ # Undo/Redo change names, they need to have the asterisk (*) after
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
@@ -87,32 +73,45 @@ proc ::pd_menus::configure_for_pdwindow {} {
proc ::pd_menus::configure_for_canvas {mytoplevel} {
variable menubar
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state normal
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state normal
- }
+ # File menu
+ $menubar.file entryconfigure [_ "Save"] -state normal
+ $menubar.file entryconfigure [_ "Save As..."] -state normal
+ $menubar.file entryconfigure [_ "Print..."] -state normal
+ $menubar.file entryconfigure [_ "Close"] -state normal
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state normal
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state normal
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state normal
+ pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
+ # Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state normal }
+ if {[$menubar.put type $i] ne "separator"} {
+ $menubar.put entryconfigure $i -state normal
+ }
}
- # TODO set "Edit Mode" state using editmode($mytoplevel)
+ update_undo_on_menu $mytoplevel
}
proc ::pd_menus::configure_for_dialog {mytoplevel} {
variable menubar
- # these are meaningless for the dialog panels, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
+ # these are meaningless for the dialog panels, so disable them except for
+ # the ones that make senes in the Find dialog panel
+ # File menu
+ if {$mytoplevel ne ".find"} {
+ $menubar.file entryconfigure [_ "Save"] -state disabled
+ $menubar.file entryconfigure [_ "Save As..."] -state disabled
+ $menubar.file entryconfigure [_ "Print..."] -state disabled
}
+ $menubar.file entryconfigure [_ "Close"] -state disabled
+ # Edit menu
+ $menubar.edit entryconfigure [_ "Duplicate"] -state disabled
+ $menubar.edit entryconfigure [_ "Tidy Up"] -state disabled
+ $menubar.edit entryconfigure [_ "Edit Mode"] -state disabled
+ pdtk_canvas_editmode $mytoplevel 0
+ # Undo/Redo change names, they need to have the asterisk (*) after
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
# disable everything on the Put menu
for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
# catch errors that happen when trying to disable separators
@@ -123,19 +122,24 @@ proc ::pd_menus::configure_for_dialog {mytoplevel} {
# ------------------------------------------------------------------------------
# menu building functions
-proc ::pd_menus::build_file_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_file_menu {mymenu} {
+ # run the platform-specific build_file_menu_* procs first, and config them
[format build_file_menu_%s $::windowingsystem] $mymenu
$mymenu entryconfigure [_ "New"] -command {menu_new}
$mymenu entryconfigure [_ "Open"] -command {menu_open}
- $mymenu entryconfigure [_ "Save"] -command {pdsend "$::focused_window menusave"}
- $mymenu entryconfigure [_ "Save As..."] -command {pdsend "$::focused_window menusaveas"}
- #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $current_toplevel}
- $mymenu entryconfigure [_ "Close"] -command {pdsend "$::focused_window menuclose 0"}
- $mymenu entryconfigure [_ "Message"] -command {menu_message_dialog}
+ $mymenu entryconfigure [_ "Save"] -command {menu_send $::focused_window menusave}
+ $mymenu entryconfigure [_ "Save As..."] -command {menu_send $::focused_window menusaveas}
+ #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $::focused_window}
+ $mymenu entryconfigure [_ "Close"] -command {menu_send_float $::focused_window menuclose 0}
+ $mymenu entryconfigure [_ "Message..."] -command {menu_message_dialog}
$mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window}
+ # update recent files
+ if {[llength $::recentfiles_list] > 0} {
+ ::pd_menus::update_recentfiles_menu false
+ }
}
-proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_edit_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
-command {menu_undo $::focused_window}
@@ -143,216 +147,340 @@ proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
-command {menu_redo $::focused_window}
$mymenu add separator
$mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
- -command {pdsend "$::focused_window cut"}
+ -command {menu_send $::focused_window cut}
$mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
- -command {pdsend "$::focused_window copy"}
+ -command {menu_send $::focused_window copy}
$mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
- -command {pdsend "$::focused_window paste"}
+ -command {menu_send $::focused_window paste}
$mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
- -command {pdsend "$::focused_window duplicate"}
+ -command {menu_send $::focused_window duplicate}
$mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
- -command {pdsend "$::focused_window selectall"}
+ -command {menu_send $::focused_window selectall}
$mymenu add separator
if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Text Editor"] \
- -command {menu_texteditor $::focused_window}
+# $mymenu add command -label [_ "Text Editor"] \
+# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
- -command {menu_font_dialog $::focused_window}
+ -command {menu_font_dialog}
} else {
- $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
- -command {menu_texteditor $::focused_window}
+# $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
+# -command {menu_texteditor}
$mymenu add command -label [_ "Font"] \
- -command {menu_font_dialog $::focused_window}
+ -command {menu_font_dialog}
}
$mymenu add command -label [_ "Tidy Up"] \
- -command {pdsend "$::focused_window tidy"}
- $mymenu add command -label [_ "Toggle Console"] -accelerator "Shift+$accelerator+R" \
- -command {.controls.switches.console invoke}
- $mymenu add command -label [_ "Clear Console"] -accelerator "Shift+$accelerator+L" \
- -command {menu_clear_console}
+ -command {menu_send $::focused_window tidy}
+ $mymenu add command -label [_ "Clear Console"] \
+ -accelerator "Shift+$accelerator+L" -command {menu_clear_console}
$mymenu add separator
- #TODO madness! how to do set the state of the check box without invoking the menu!
+ #TODO madness! how to set the state of the check box without invoking the menu!
$mymenu add check -label [_ "Edit Mode"] -accelerator "$accelerator+E" \
- -selectcolor grey85 \
- -command {pdsend "$::focused_window editmode 0"}
- #if { ! [catch {console hide}]} {
- # TODO set up menu item to show/hide the Tcl/Tk console, if it available
- #}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add separator
- $mymenu add command -label [_ "Preferences"] \
- -command {menu_preferences_dialog}
- }
+ -variable ::editmode_button \
+ -command {menu_editmode $::editmode_button}
}
-proc ::pd_menus::build_put_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_put_menu {mymenu} {
variable accelerator
+ # The trailing 0 in menu_send_float basically means leave the object box
+ # sticking to the mouse cursor. The iemguis alway do that when created
+ # from the menu, as defined in canvas_iemguis()
$mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
- -command {pdsend "$::focused_window obj 0"}
+ -command {menu_send_float $::focused_window obj 0}
$mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
- -command {pdsend "$::focused_window msg 0"}
+ -command {menu_send_float $::focused_window msg 0}
$mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
- -command {pdsend "$::focused_window floatatom 0"}
+ -command {menu_send_float $::focused_window floatatom 0}
$mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
- -command {pdsend "$::focused_window symbolatom 0"}
+ -command {menu_send_float $::focused_window symbolatom 0}
$mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
- -command {pdsend "$::focused_window text 0"}
+ -command {menu_send_float $::focused_window text 0}
$mymenu add separator
$mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
- -command {pdsend "$::focused_window bng 0"}
+ -command {menu_send $::focused_window bng}
$mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
- -command {pdsend "$::focused_window toggle 0"}
+ -command {menu_send $::focused_window toggle}
$mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
- -command {pdsend "$::focused_window numbox 0"}
+ -command {menu_send $::focused_window numbox}
$mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
- -command {pdsend "$::focused_window vslider 0"}
+ -command {menu_send $::focused_window vslider}
$mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
- -command {pdsend "$::focused_window hslider 0"}
+ -command {menu_send $::focused_window hslider}
$mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
- -command {pdsend "$::focused_window vradio 0"}
+ -command {menu_send $::focused_window vradio}
$mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
- -command {pdsend "$::focused_window hradio 0"}
+ -command {menu_send $::focused_window hradio}
$mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
- -command {pdsend "$::focused_window vumeter 0"}
+ -command {menu_send $::focused_window vumeter}
$mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
- -command {pdsend "$::focused_window mycnv 0"}
+ -command {menu_send $::focused_window mycnv}
$mymenu add separator
- $mymenu add command -label [_ "Graph"] -command {pdsend "$::focused_window graph"}
- $mymenu add command -label [_ "Array"] -command {pdsend "$::focused_window menuarray"}
+ $mymenu add command -label [_ "Graph"] -command {menu_send $::focused_window graph}
+ $mymenu add command -label [_ "Array"] -command {menu_send $::focused_window menuarray}
}
-proc ::pd_menus::build_find_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_find_menu {mymenu} {
variable accelerator
$mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
- -command {::dialog_find::menu_find_dialog $::focused_window}
+ -command {menu_find_dialog}
$mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
- -command {pdsend "$::focused_window findagain"}
+ -command {menu_send $::focused_window findagain}
$mymenu add command -label [_ "Find Last Error"] \
- -command {pdsend "$::focused_window finderror"}
+ -command {pdsend {pd finderror}}
}
-proc ::pd_menus::build_media_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_media_menu {mymenu} {
variable accelerator
$mymenu add radiobutton -label [_ "DSP On"] -accelerator "$accelerator+/" \
-variable ::dsp -value 1 -command {pdsend "pd dsp 1"}
$mymenu add radiobutton -label [_ "DSP Off"] -accelerator "$accelerator+." \
-variable ::dsp -value 0 -command {pdsend "pd dsp 0"}
+
$mymenu add separator
+ $mymenu add command -label [_ "Test Audio and MIDI..."] \
+ -command {menu_doc_open doc/7.stuff/tools testtone.pd}
+ $mymenu add command -label [_ "Load Meter"] \
+ -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
- set audioapi_list_length [llength $::audioapi_list]
- for {set x 0} {$x<$audioapi_list_length} {incr x} {
- # pdtk_post "audio [lindex [lindex $::audioapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::audioapi_list $x] 0] \
+ set audio_apilist_length [llength $::audio_apilist]
+ if {$audio_apilist_length > 0} {$mymenu add separator}
+ for {set x 0} {$x<$audio_apilist_length} {incr x} {
+ $mymenu add radiobutton -label [lindex [lindex $::audio_apilist $x] 0] \
-command {menu_audio 0} -variable ::pd_whichapi \
- -value [lindex [lindex $::audioapi_list $x] 1]\
+ -value [lindex [lindex $::audio_apilist $x] 1]\
-command {pdsend "pd audio-setapi $::pd_whichapi"}
}
- if {$audioapi_list_length > 0} {$mymenu add separator}
-
- set midiapi_list_length [llength $::midiapi_list]
- for {set x 0} {$x<$midiapi_list_length} {incr x} {
- # pdtk_post "midi [lindex [lindex $::midiapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::midiapi_list $x] 0] \
+
+ set midi_apilist_length [llength $::midi_apilist]
+ if {$midi_apilist_length > 0} {$mymenu add separator}
+ for {set x 0} {$x<$midi_apilist_length} {incr x} {
+ $mymenu add radiobutton -label [lindex [lindex $::midi_apilist $x] 0] \
-command {menu_midi 0} -variable ::pd_whichmidiapi \
- -value [lindex [lindex $::midiapi_list $x] 1]\
+ -value [lindex [lindex $::midi_apilist $x] 1]\
-command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
}
- if {$midiapi_list_length > 0} {$mymenu add separator}
-
if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "Audio settings..."] \
- -command {pdsend "pd audio-properties"}
- $mymenu add command -label [_ "MIDI settings..."] \
- -command {pdsend "pd midi-properties"}
$mymenu add separator
+ create_preferences_menu $mymenu.preferences
+ $mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
}
- $mymenu add command -label [_ "Test Audio and MIDI..."] \
- -command {menu_doc_open doc/7.stuff/tools testtone.pd}
- $mymenu add command -label [_ "Load Meter"] \
- -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
}
-proc ::pd_menus::build_window_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_window_menu {mymenu} {
variable accelerator
if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Minimize"] -command {menu_minimize .} \
- -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Zoom"] -command {menu_zoom .}
+ $mymenu add command -label [_ "Minimize"] -accelerator "$accelerator+M"\
+ -command {menu_minimize $::focused_window}
+ $mymenu add command -label [_ "Zoom"] \
+ -command {menu_maximize $::focused_window}
$mymenu add separator
+ $mymenu add command -label [_ "Bring All to Front"] \
+ -command {menu_bringalltofront}
+ } else {
+ $mymenu add command -label [_ "Next Window"] \
+ -command {menu_raisenextwindow} \
+ -accelerator [_ "$accelerator+Page Down"]
+ $mymenu add command -label [_ "Previous Window"] \
+ -command {menu_raisepreviouswindow} \
+ -accelerator [_ "$accelerator+Page Up"]
}
- $mymenu add command -label [_ "Parent Window"] \
- -command {pdsend "$::focused_window findparent"}
+ $mymenu add separator
$mymenu add command -label [_ "Pd window"] -command {menu_raise_pdwindow} \
-accelerator "$accelerator+R"
+ $mymenu add command -label [_ "Parent Window"] \
+ -command {menu_send $::focused_window findparent}
$mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Bring All to Front"] \
- -command {menu_bringalltofront}
- $mymenu add separator
- }
}
-proc ::pd_menus::build_help_menu {mymenu mytoplevel} {
+proc ::pd_menus::build_help_menu {mymenu} {
if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
+ $mymenu add command -label [_ "About Pd"] -command {menu_aboutpd}
}
$mymenu add command -label [_ "HTML Manual..."] \
-command {menu_doc_open doc/1.manual index.htm}
$mymenu add command -label [_ "Browser..."] \
- -command {placeholder menu_helpbrowser \$help_top_directory}
+ -command {menu_helpbrowser}
+ $mymenu add separator
+ $mymenu add command -label [_ "puredata.info"] \
+ -command {menu_openfile {http://puredata.info}}
+ $mymenu add command -label [_ "Report a bug"] -command {menu_openfile \
+ {http://sourceforge.net/tracker/?func=add&group_id=55736&atid=478070}}
+ $mymenu add separator
+ $mymenu add command -label [_ "Tcl prompt"] -command \
+ {::pdwindow::create_tcl_entry}
+
+}
+
+#------------------------------------------------------------------------------#
+# undo/redo menu items
+
+proc ::pd_menus::update_undo_on_menu {mytoplevel} {
+ variable menubar
+ if {$mytoplevel eq $::undo_toplevel && $::undo_action ne "no"} {
+ $menubar.edit entryconfigure 0 -state normal \
+ -label [_ "Undo $::undo_action"]
+ } else {
+ $menubar.edit entryconfigure 0 -state disabled -label [_ "Undo"]
+ }
+ if {$mytoplevel eq $::undo_toplevel && $::redo_action ne "no"} {
+ $menubar.edit entryconfigure 1 -state normal \
+ -label [_ "Redo $::redo_action"]
+ } else {
+ $menubar.edit entryconfigure 1 -state disabled -label [_ "Redo"]
+ }
}
# ------------------------------------------------------------------------------
-# update the menu entries for opening recent files
-proc ::pd_menus::update_recentfiles_menu {} {
+# update the menu entries for opening recent files (write arg should always be true except the first time when pd is opened)
+proc ::pd_menus::update_recentfiles_menu {{write true}} {
variable menubar
switch -- $::windowingsystem {
- "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent}
- "win32" {update_recentfiles_on_menu $menubar.file}
- "x11" {update_recentfiles_on_menu $menubar.file}
+ "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent $write}
+ "win32" {::pd_menus::update_recentfiles_on_menu $menubar.file $write}
+ "x11" {::pd_menus::update_recentfiles_on_menu $menubar.file $write}
}
}
proc ::pd_menus::clear_recentfiles_menu {} {
set ::recentfiles_list {}
::pd_menus::update_recentfiles_menu
+ # empty recentfiles in preferences (write empty array)
+ ::pd_guiprefs::write_recentfiles
}
-proc ::pd_menus::update_openrecent_menu_aqua {mymenu} {
+proc ::pd_menus::update_openrecent_menu_aqua {mymenu {write}} {
if {! [winfo exists $mymenu]} {menu $mymenu}
$mymenu delete 0 end
+
+ # now the list is last first so we just add
foreach filename $::recentfiles_list {
- puts "creating menu item for $filename"
$mymenu add command -label [file tail $filename] \
- -command "open_file $filename"
+ -command "open_file {$filename}"
}
+ # clear button
$mymenu add separator
$mymenu add command -label [_ "Clear Menu"] \
-command "::pd_menus::clear_recentfiles_menu"
+ # write to config file
+ if {$write == true} { ::pd_guiprefs::write_recentfiles }
}
+# ------------------------------------------------------------------------------
# this expects to be run on the File menu, and to insert above the last separator
-proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
+proc ::pd_menus::update_recentfiles_on_menu {mymenu {write}} {
set lastitem [$mymenu index end]
set i 1
while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
set bottom_separator [expr $lastitem-$i]
incr i
+
while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
set top_separator [expr $lastitem-$i]
if {$top_separator < [expr $bottom_separator-1]} {
$mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
}
- set i 0
- foreach filename $::recentfiles_list {
- $mymenu insert [expr $top_separator+$i+1] command \
- -label [file tail $filename] -command "open_file $filename"
- incr i
+ # insert the list from the end because we insert each element on the top
+ set i [llength $::recentfiles_list]
+ while {[incr i -1] > 0} {
+
+ set filename [lindex $::recentfiles_list $i]
+ $mymenu insert [expr $top_separator+1] command \
+ -label [file tail $filename] -command "open_file {$filename}"
+ }
+ set filename [lindex $::recentfiles_list 0]
+ $mymenu insert [expr $top_separator+1] command \
+ -label [file tail $filename] -command "open_file {$filename}"
+
+ # write to config file
+ if {$write == true} { ::pd_guiprefs::write_recentfiles }
+}
+
+# ------------------------------------------------------------------------------
+# lots of crazy recursion to update the Window menu
+
+# find the first parent patch that has a mapped window
+proc ::pd_menus::find_mapped_parent {parentlist} {
+ if {[llength $parentlist] == 0} {return "none"}
+ set firstparent [lindex $parentlist 0]
+ if {[winfo exists $firstparent]} {
+ return $firstparent
+ } elseif {[llength $parentlist] > 1} {
+ return [find_mapped_parent [lrange $parentlist 1 end]]
+ } else {
+ # we must be the first menu item to be inserted
+ return "none"
+ }
+}
+
+# find the first parent patch that has a mapped window
+proc ::pd_menus::insert_into_menu {mymenu entry parent} {
+ set insertat [$mymenu index end]
+ for {set i 0} {$i <= [$mymenu index end]} {incr i} {
+ if {[$mymenu type $i] ne "command"} {continue}
+ set currentcommand [$mymenu entrycget $i -command]
+ if {$currentcommand eq "raise $entry"} {return} ;# it exists already
+ if {$currentcommand eq "raise $parent"} {
+ set insertat $i
+ }
+ }
+ incr insertat
+ set label ""
+ for {set i 0} {$i < [llength $::parentwindows($entry)]} {incr i} {
+ append label " "
+ }
+ append label $::windowname($entry)
+ $mymenu insert $insertat command -label $label -command "raise $entry"
+}
+
+# recurse through a list of parent windows and add to the menu
+proc ::pd_menus::add_list_to_menu {mymenu window parentlist} {
+ if {[llength $parentlist] == 0} {
+ insert_into_menu $mymenu $window {}
+ } else {
+ set entry [lindex $parentlist end]
+ if {[winfo exists $entry]} {
+ insert_into_menu $mymenu $entry \
+ [find_mapped_parent $::parentwindows($entry)]
+ }
+ }
+ if {[llength $parentlist] > 1} {
+ add_list_to_menu $mymenu $window [lrange $parentlist 0 end-1]
+ }
+}
+
+# update the list of windows on the Window menu. This expects run on the
+# Window menu, and to insert below the last separator
+proc ::pd_menus::update_window_menu {} {
+ set mymenu $::patch_menubar.window
+ # find the last separator and delete everything after that
+ for {set i 0} {$i <= [$mymenu index end]} {incr i} {
+ if {[$mymenu type $i] eq "separator"} {
+ set deleteat $i
+ }
+ }
+ $mymenu delete $deleteat end
+ $mymenu add separator
+ foreach window [array names ::parentwindows] {
+ set parentlist $::parentwindows($window)
+ add_list_to_menu $mymenu $window $parentlist
+ insert_into_menu $mymenu $window [find_mapped_parent $parentlist]
}
}
+# ------------------------------------------------------------------------------
+# submenu for Preferences, now used on all platforms
+
+proc ::pd_menus::create_preferences_menu {mymenu} {
+ menu $mymenu
+ $mymenu add command -label [_ "Path..."] \
+ -command {pdsend "pd start-path-dialog"}
+ $mymenu add command -label [_ "Startup..."] \
+ -command {pdsend "pd start-startup-dialog"}
+ $mymenu add command -label [_ "Audio Settings..."] \
+ -command {pdsend "pd audio-properties"}
+ $mymenu add command -label [_ "MIDI Settings..."] \
+ -command {pdsend "pd midi-properties"}
+}
+
# ------------------------------------------------------------------------------
# menu building functions for Mac OS X/aqua
@@ -360,23 +488,22 @@ proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
proc ::pd_menus::create_apple_menu {mymenu} {
# TODO this should open a Pd patch called about.pd
menu $mymenu.apple
- $mymenu.apple add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- $mymenu add cascade -label "Apple" -menu $mymenu.apple
+ $mymenu.apple add command -label [_ "About Pd"] -command {menu_aboutpd}
$mymenu.apple add separator
- # starting in 8.4.14, this is created automatically
- set patchlevel [split [info patchlevel] .]
- if {[lindex $patchlevel 1] < 5 && [lindex $patchlevel 2] < 14} {
- $mymenu.apple add command -label [_ "Preferences..."] \
- -command {menu_preferences_dialog" -accelerator "Cmd+,}
- }
+ create_preferences_menu $mymenu.apple.preferences
+ $mymenu.apple add cascade -label [_ "Preferences"] \
+ -menu $mymenu.apple.preferences
+ # this needs to be last for things to function properly
+ $mymenu add cascade -label "Apple" -menu $mymenu.apple
+
}
proc ::pd_menus::build_file_menu_aqua {mymenu} {
variable accelerator
$mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
$mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- ::pd_menus::update_openrecent_menu_aqua .openrecent
+ # this is now done in main ::pd_menus::build_file_menu
+ #::pd_menus::update_openrecent_menu_aqua .openrecent
$mymenu add cascade -label [_ "Open Recent"] -menu .openrecent
$mymenu add separator
$mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
@@ -385,7 +512,7 @@ proc ::pd_menus::build_file_menu_aqua {mymenu} {
#$mymenu add command -label [_ "Save All"]
#$mymenu add command -label [_ "Revert to Saved"]
$mymenu add separator
- $mymenu add command -label [_ "Message"]
+ $mymenu add command -label [_ "Message..."]
$mymenu add separator
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
}
@@ -412,7 +539,7 @@ proc ::pd_menus::build_file_menu_x11 {mymenu} {
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
@@ -436,10 +563,16 @@ proc ::pd_menus::build_window_menu_x11 {mymenu} {
# menu building functions for Windows/Win32
# for Windows only
-proc ::pd_menus::create_system_menu {mymenu} {
- $mymenu add cascade -menu [menu $mymenu.system]
+proc ::pd_menus::create_system_menu {mymenubar} {
+ set mymenu $mymenubar.system
+ $mymenubar add cascade -label System -menu $mymenu
+ menu $mymenu -tearoff 0
+ # placeholders
+ $mymenu add command -label [_ "Edit Mode"] -command "::pdwindow::verbose 0 systemmenu"
# TODO add Close, Minimize, etc and whatever else is on the little menu
# that is on the top left corner of the window frame
+ # http://wiki.tcl.tk/1006
+ # TODO add Edit Mode here
}
proc ::pd_menus::build_file_menu_win32 {mymenu} {
@@ -451,7 +584,9 @@ proc ::pd_menus::build_file_menu_win32 {mymenu} {
$mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
# $mymenu add command -label "Revert"
$mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Message..."] -accelerator "$accelerator+M"
+ create_preferences_menu $mymenu.preferences
+ $mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
$mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
$mymenu add separator
# the recent files get inserted in here by update_recentfiles_on_menu
@@ -470,4 +605,3 @@ proc ::pd_menus::build_window_menu_win32 {mymenu} {
}
# the "Help" does not have cross-platform differences
-
diff --git a/pd/tcl/pd_menus.tcl~ b/pd/tcl/pd_menus.tcl~
deleted file mode 100644
index 94e6a9cd5..000000000
--- a/pd/tcl/pd_menus.tcl~
+++ /dev/null
@@ -1,473 +0,0 @@
-# Copyright (c) 1997-2009 Miller Puckette.
-#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
-
-package provide pd_menus 0.1
-
-package require pd_menucommands
-package require Tk
-#package require tile
-## replace Tk widgets with Ttk widgets on 8.5
-#namespace import -force ttk::*
-
-# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
-# TODO figure out parent window/window list for Window menu
-# TODO what is the Tcl package constructor or init()?
-# TODO $::pd_menus::menubar or .menubar globally?
-
-# since there is one menubar that is used for all windows, the menu -commands
-# use {} quotes so that $::focused_window is interpreted when the menu item
-# is called, not when the command is mapped to the menu item. This is the
-# opposite of the 'bind' commands in pd_bindings.tcl
-
-
-# ------------------------------------------------------------------------------
-# global variables
-
-# TODO this should properly be inside the pd_menus namespace, now it is global
-namespace import ::pd_menucommands::*
-
-namespace eval ::pd_menus:: {
- variable accelerator
- variable menubar ".menubar"
- variable current_toplevel ".pdwindow"
-
- namespace export create_menubar
- namespace export configure_for_pdwindow
- namespace export configure_for_canvas
- namespace export configure_for_dialog
-
- # turn off tearoff menus globally
- option add *tearOff 0
-}
-
-# ------------------------------------------------------------------------------
-#
-proc ::pd_menus::create_menubar {} {
- variable accelerator
- variable menubar
- if {$::windowingsystem eq "aqua"} {
- set accelerator "Cmd"
- } else {
- set accelerator "Ctrl"
- }
- menu $menubar
- set menulist "file edit put find media window help"
- if { $::windowingsystem eq "aqua" } {create_apple_menu $menubar}
- # FIXME why does the following (if uncommented) kill my menubar?
- # if { $::windowingsystem eq "win32" } {create_system_menu $menubar}
- foreach mymenu $menulist {
- menu $menubar.$mymenu
- $menubar add cascade -label [_ [string totitle $mymenu]] \
- -menu $menubar.$mymenu
- [format build_%s_menu $mymenu] $menubar.$mymenu .
- if {$::windowingsystem eq "win32"} {
- # fix menu font size on Windows with tk scaling = 1
- $menubar.$mymenu configure -font menufont
- }
- }
-}
-
-proc ::pd_menus::configure_for_pdwindow {} {
- variable menubar
- # these are meaningless for the Pd window, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
- # disable everything on the Put menu
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-proc ::pd_menus::configure_for_canvas {mytoplevel} {
- variable menubar
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state normal
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state normal
- }
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state normal }
- }
- # TODO set "Edit Mode" state using editmode($mytoplevel)
-}
-
-proc ::pd_menus::configure_for_dialog {mytoplevel} {
- variable menubar
- # these are meaningless for the dialog panels, so disable them
- set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
- foreach menuitem $file_items_to_disable {
- $menubar.file entryconfigure [_ $menuitem] -state disabled
- }
- set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
- foreach menuitem $edit_items_to_disable {
- $menubar.edit entryconfigure [_ $menuitem] -state disabled
- }
- # disable everything on the Put menu
- for {set i 0} {$i <= [$menubar.put index end]} {incr i} {
- # catch errors that happen when trying to disable separators
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-
-# ------------------------------------------------------------------------------
-# menu building functions
-proc ::pd_menus::build_file_menu {mymenu mytoplevel} {
- [format build_file_menu_%s $::windowingsystem] $mymenu
- $mymenu entryconfigure [_ "New"] -command {menu_new}
- $mymenu entryconfigure [_ "Open"] -command {menu_open}
- $mymenu entryconfigure [_ "Save"] -command {pdsend "$::focused_window menusave"}
- $mymenu entryconfigure [_ "Save As..."] -command {pdsend "$::focused_window menusaveas"}
- #$mymenu entryconfigure [_ "Revert*"] -command {menu_revert $current_toplevel}
- $mymenu entryconfigure [_ "Close"] -command {pdsend "$::focused_window menuclose 0"}
- $mymenu entryconfigure [_ "Message"] -command {menu_message_dialog}
- $mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window}
-}
-
-proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
- -command {menu_undo $::focused_window}
- $mymenu add command -label [_ "Redo"] -accelerator "Shift+$accelerator+Z" \
- -command {menu_redo $::focused_window}
- $mymenu add separator
- $mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
- -command {pdsend "$::focused_window cut"}
- $mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
- -command {pdsend "$::focused_window copy"}
- $mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
- -command {pdsend "$::focused_window paste"}
- $mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
- -command {pdsend "$::focused_window duplicate"}
- $mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
- -command {pdsend "$::focused_window selectall"}
- $mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Text Editor"] \
- -command {menu_texteditor $::focused_window}
- $mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
- -command {menu_font_dialog $::focused_window}
- } else {
- $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
- -command {menu_texteditor $::focused_window}
- $mymenu add command -label [_ "Font"] \
- -command {menu_font_dialog $::focused_window}
- }
- $mymenu add command -label [_ "Tidy Up"] \
- -command {pdsend "$::focused_window tidy"}
- $mymenu add command -label [_ "Toggle Console"] -accelerator "Shift+$accelerator+R" \
- -command {.controls.switches.console invoke}
- $mymenu add command -label [_ "Clear Console"] -accelerator "Shift+$accelerator+L" \
- -command {menu_clear_console}
- $mymenu add separator
- $mymenu add checkbutton -label [_ "Edit Mode"] \
- -accelerator "$accelerator+E" -variable ::editmode_button \
- -command {menu_editmode $::editmode_button}
- -command {pdsend "$::focused_window editmode 0"}
- #if { ! [catch {console hide}]} {
- # TODO set up menu item to show/hide the Tcl/Tk console, if it available
- #}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add separator
- $mymenu add command -label [_ "Preferences"] \
- -command {menu_preferences_dialog}
- }
-}
-
-proc ::pd_menus::build_put_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
- -command {pdsend "$::focused_window obj 0"}
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
- -command {pdsend "$::focused_window msg 0"}
- $mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
- -command {pdsend "$::focused_window floatatom 0"}
- $mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
- -command {pdsend "$::focused_window symbolatom 0"}
- $mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
- -command {pdsend "$::focused_window text 0"}
- $mymenu add separator
- $mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
- -command {pdsend "$::focused_window bng 0"}
- $mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
- -command {pdsend "$::focused_window toggle 0"}
- $mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
- -command {pdsend "$::focused_window numbox 0"}
- $mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
- -command {pdsend "$::focused_window vslider 0"}
- $mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
- -command {pdsend "$::focused_window hslider 0"}
- $mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
- -command {pdsend "$::focused_window vradio 0"}
- $mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
- -command {pdsend "$::focused_window hradio 0"}
- $mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
- -command {pdsend "$::focused_window vumeter 0"}
- $mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
- -command {pdsend "$::focused_window mycnv 0"}
- $mymenu add separator
- $mymenu add command -label [_ "Graph"] -command {pdsend "$::focused_window graph"}
- $mymenu add command -label [_ "Array"] -command {pdsend "$::focused_window menuarray"}
-}
-
-proc ::pd_menus::build_find_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
- -command {::dialog_find::menu_find_dialog $::focused_window}
- $mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
- -command {pdsend "$::focused_window findagain"}
- $mymenu add command -label [_ "Find Last Error"] \
- -command {pdsend "$::focused_window finderror"}
-}
-
-proc ::pd_menus::build_media_menu {mymenu mytoplevel} {
- variable accelerator
- $mymenu add radiobutton -label [_ "DSP On"] -accelerator "$accelerator+/" \
- -variable ::dsp -value 1 -command {pdsend "pd dsp 1"}
- $mymenu add radiobutton -label [_ "DSP Off"] -accelerator "$accelerator+." \
- -variable ::dsp -value 0 -command {pdsend "pd dsp 0"}
- $mymenu add separator
-
- set audioapi_list_length [llength $::audioapi_list]
- for {set x 0} {$x<$audioapi_list_length} {incr x} {
- # pdtk_post "audio [lindex [lindex $::audioapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::audioapi_list $x] 0] \
- -command {menu_audio 0} -variable ::pd_whichapi \
- -value [lindex [lindex $::audioapi_list $x] 1]\
- -command {pdsend "pd audio-setapi $::pd_whichapi"}
- }
- if {$audioapi_list_length > 0} {$mymenu add separator}
-
- set midiapi_list_length [llength $::midiapi_list]
- for {set x 0} {$x<$midiapi_list_length} {incr x} {
- # pdtk_post "midi [lindex [lindex $::midiapi_list $x] 0]"
- $mymenu add radiobutton -label [lindex [lindex $::midiapi_list $x] 0] \
- -command {menu_midi 0} -variable ::pd_whichmidiapi \
- -value [lindex [lindex $::midiapi_list $x] 1]\
- -command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
- }
- if {$midiapi_list_length > 0} {$mymenu add separator}
-
- if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "Audio settings..."] \
- -command {pdsend "pd audio-properties"}
- $mymenu add command -label [_ "MIDI settings..."] \
- -command {pdsend "pd midi-properties"}
- $mymenu add separator
- }
- $mymenu add command -label [_ "Test Audio and MIDI..."] \
- -command {menu_doc_open doc/7.stuff/tools testtone.pd}
- $mymenu add command -label [_ "Load Meter"] \
- -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
-}
-
-proc ::pd_menus::build_window_menu {mymenu mytoplevel} {
- variable accelerator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Minimize"] -command {menu_minimize .} \
- -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Zoom"] -command {menu_zoom .}
- $mymenu add separator
- }
- $mymenu add command -label [_ "Parent Window"] \
- -command {pdsend "$::focused_window findparent"}
- $mymenu add command -label [_ "Pd window"] -command {menu_raise_pdwindow} \
- -accelerator "$accelerator+R"
- $mymenu add separator
- if {$::windowingsystem eq "aqua"} {
- $mymenu add command -label [_ "Bring All to Front"] \
- -command {menu_bringalltofront}
- $mymenu add separator
- }
-}
-
-proc ::pd_menus::build_help_menu {mymenu mytoplevel} {
- if {$::windowingsystem ne "aqua"} {
- $mymenu add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- }
- $mymenu add command -label [_ "HTML Manual..."] \
- -command {menu_doc_open doc/1.manual index.htm}
- $mymenu add command -label [_ "Browser..."] \
- -command {placeholder menu_helpbrowser \$help_top_directory}
-}
-
-# ------------------------------------------------------------------------------
-# update the menu entries for opening recent files
-proc ::pd_menus::update_recentfiles_menu {} {
- variable menubar
- switch -- $::windowingsystem {
- "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent}
- "win32" {update_recentfiles_on_menu $menubar.file}
- "x11" {update_recentfiles_on_menu $menubar.file}
- }
-}
-
-proc ::pd_menus::clear_recentfiles_menu {} {
- set ::recentfiles_list {}
- ::pd_menus::update_recentfiles_menu
-}
-
-proc ::pd_menus::update_openrecent_menu_aqua {mymenu} {
- if {! [winfo exists $mymenu]} {menu $mymenu}
- $mymenu delete 0 end
- foreach filename $::recentfiles_list {
- puts "creating menu item for $filename"
- $mymenu add command -label [file tail $filename] \
- -command "open_file $filename"
- }
- $mymenu add separator
- $mymenu add command -label [_ "Clear Menu"] \
- -command "::pd_menus::clear_recentfiles_menu"
-}
-
-# this expects to be run on the File menu, and to insert above the last separator
-proc ::pd_menus::update_recentfiles_on_menu {mymenu} {
- set lastitem [$mymenu index end]
- set i 1
- while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
- set bottom_separator [expr $lastitem-$i]
- incr i
- while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i}
- set top_separator [expr $lastitem-$i]
- if {$top_separator < [expr $bottom_separator-1]} {
- $mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
- }
- set i 0
- foreach filename $::recentfiles_list {
- $mymenu insert [expr $top_separator+$i+1] command \
- -label [file tail $filename] -command "open_file $filename"
- incr i
- }
-}
-
-# ------------------------------------------------------------------------------
-# menu building functions for Mac OS X/aqua
-
-# for Mac OS X only
-proc ::pd_menus::create_apple_menu {mymenu} {
- # TODO this should open a Pd patch called about.pd
- menu $mymenu.apple
- $mymenu.apple add command -label [_ "About Pd"] \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- $mymenu add cascade -label "Apple" -menu $mymenu.apple
- $mymenu.apple add separator
- # starting in 8.4.14, this is created automatically
- set patchlevel [split [info patchlevel] .]
- if {[lindex $patchlevel 1] < 5 && [lindex $patchlevel 2] < 14} {
- $mymenu.apple add command -label [_ "Preferences..."] \
- -command {menu_preferences_dialog" -accelerator "Cmd+,}
- }
-}
-
-proc ::pd_menus::build_file_menu_aqua {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- ::pd_menus::update_openrecent_menu_aqua .openrecent
- $mymenu add cascade -label [_ "Open Recent"] -menu .openrecent
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "$accelerator+Shift+S"
- #$mymenu add command -label [_ "Save All"]
- #$mymenu add command -label [_ "Revert to Saved"]
- $mymenu add separator
- $mymenu add command -label [_ "Message"]
- $mymenu add separator
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_aqua {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_aqua {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
-# ------------------------------------------------------------------------------
-# menu building functions for UNIX/X11
-
-proc ::pd_menus::build_file_menu_x11 {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- $mymenu add separator
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
- # $mymenu add command -label "Revert"
- $mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
- $mymenu add separator
- # the recent files get inserted in here by update_recentfiles_on_menu
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q" \
- -command {pdsend "pd verifyquit"}
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_x11 {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_x11 {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
-# ------------------------------------------------------------------------------
-# menu building functions for Windows/Win32
-
-# for Windows only
-proc ::pd_menus::create_system_menu {mymenu} {
- $mymenu add cascade -menu [menu $mymenu.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::build_file_menu_win32 {mymenu} {
- variable accelerator
- $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
- $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
- $mymenu add separator
- $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
- $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
- # $mymenu add command -label "Revert"
- $mymenu add separator
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
- $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
- $mymenu add separator
- # the recent files get inserted in here by update_recentfiles_on_menu
- $mymenu add separator
- $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
- $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q"\
- -command {pdsend "pd verifyquit"}
-}
-
-# the "Edit", "Put", and "Find" menus do not have cross-platform differences
-
-proc ::pd_menus::build_media_menu_win32 {mymenu} {
-}
-
-proc ::pd_menus::build_window_menu_win32 {mymenu} {
-}
-
-# the "Help" does not have cross-platform differences
-
diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl
index 31505cec4..6db3f1b98 100644
--- a/pd/tcl/pdtk_canvas.tcl
+++ b/pd/tcl/pdtk_canvas.tcl
@@ -4,38 +4,122 @@ package provide pdtk_canvas 0.1
package require pd_bindings
namespace eval ::pdtk_canvas:: {
+ namespace export pdtk_canvas_popup
+ namespace export pdtk_canvas_editmode
+ namespace export pdtk_canvas_getscroll
+ namespace export pdtk_canvas_setparents
+ namespace export pdtk_canvas_reflecttitle
+ namespace export pdtk_canvas_menuclose
}
+# One thing that is tricky to understand is the difference between a Tk
+# 'canvas' and a 'canvas' in terms of Pd's implementation. They are similar,
+# but not the same thing. In Pd code, a 'canvas' is basically a patch, while
+# the Tk 'canvas' is the backdrop for drawing everything that is in a patch.
+# The Tk 'canvas' is contained in a 'toplevel' window. That window has a Tk
+# class of 'PatchWindow'.
+
# TODO figure out weird frameless window when you open a graph
+
+#TODO: http://wiki.tcl.tk/11502
+# MS Windows
+#wm geometry . returns contentswidthxcontentsheight+decorationTop+decorationLeftEdge.
+#and
+#winfo rooty . returns contentsTop
+#winfo rootx . returns contentsLeftEdge
+
+
+# this proc is split out on its own to make it easy to override. This makes it
+# easy for people to customize these calculations based on their Window
+# Manager, desires, etc.
+proc pdtk_canvas_place_window {width height geometry} {
+ set screenwidth [lindex [wm maxsize .] 0]
+ set screenheight [lindex [wm maxsize .] 1]
+
+ # read back the current geometry +posx+posy into variables
+ scan $geometry {%[+]%d%[+]%d} - x - y
+ # fit the geometry onto screen
+ set x [ expr $x % $screenwidth - $::windowframex]
+ set y [ expr $y % $screenheight - $::windowframey]
+ if {$x < 0} {set x 0}
+ if {$y < 0} {set y 0}
+ if {$width > $screenwidth} {
+ set width $screenwidth
+ set x 0
+ }
+ if {$height > $screenheight} {
+ set height [expr $screenheight - $::menubarsize - 30] ;# 30 for window framing
+ set y $::menubarsize
+ }
+ return [list $width $height ${width}x$height+$x+$y]
+}
+
+
#------------------------------------------------------------------------------#
# canvas new/saveas
proc pdtk_canvas_new {mytoplevel width height geometry editable} {
- # TODO check size of window
- toplevel $mytoplevel -width $width -height $height -class CanvasWindow
+ set l [pdtk_canvas_place_window $width $height $geometry]
+ set width [lindex $l 0]
+ set height [lindex $l 1]
+ set geometry [lindex $l 2]
+
+ # release the window grab here so that the new window will
+ # properly get the Map and FocusIn events when its created
+ ::pdwindow::busyrelease
+ # set the loaded array for this new window so things can track state
+ set ::loaded($mytoplevel) 0
+ toplevel $mytoplevel -width $width -height $height -class PatchWindow
wm group $mytoplevel .
- $mytoplevel configure -menu .menubar
+ $mytoplevel configure -menu $::patch_menubar
+
+ # we have to wait until $mytoplevel exists before we can generate
+ # a <<Loading>> event for it, that's why this is here and not in the
+ # started_loading_file proc. Perhaps this doesn't make sense tho
+ event generate $mytoplevel <<Loading>>
- # TODO slide off screen windows into view
wm geometry $mytoplevel $geometry
- if {$::windowingsystem eq "aqua"} { # no menubar, it can be small
- wm minsize $mytoplevel 50 20
- } else { # leave room for the menubar
- wm minsize $mytoplevel 310 30
+ wm minsize $mytoplevel $::canvas_minwidth $::canvas_minheight
+
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ canvas $tkcanvas -width $width -height $height \
+ -highlightthickness 0 -scrollregion [list 0 0 $width $height] \
+ -xscrollcommand "$mytoplevel.xscroll set" \
+ -yscrollcommand "$mytoplevel.yscroll set"
+ scrollbar $mytoplevel.xscroll -orient horizontal -command "$tkcanvas xview"
+ scrollbar $mytoplevel.yscroll -orient vertical -command "$tkcanvas yview"
+ pack $tkcanvas -side left -expand 1 -fill both
+
+ # for some crazy reason, win32 mousewheel scrolling is in units of
+ # 120, and this forces Tk to interpret 120 to mean 1 scroll unit
+ if {$::windowingsystem eq "win32"} {
+ $tkcanvas configure -xscrollincrement 1 -yscrollincrement 1
}
-
- set ::editmode($mytoplevel) $editable
- set mycanvas $mytoplevel.c
- canvas $mycanvas -width $width -height $height -background white \
- -highlightthickness 0
- # TODO add scrollbars here
- pack $mycanvas -side left -expand 1 -fill both
+ ::pd_bindings::patch_bindings $mytoplevel
+
+ # give focus to the canvas so it gets the events rather than the window
+ focus $tkcanvas
+
+ # let the scrollbar logic determine if it should make things scrollable
+ set ::xscrollable($tkcanvas) 0
+ set ::yscrollable($tkcanvas) 0
+
+ # init patch properties arrays
+ set ::editingtext($mytoplevel) 0
+ set ::childwindows($mytoplevel) {}
- ::pd_bindings::canvas_bindings $mytoplevel
+ # this should be at the end so that the window and canvas are all ready
+ # before this variable changes.
+ set ::editmode($mytoplevel) $editable
+}
- # give focus to the canvas so it gets the events rather than the window
+# if the patch canvas window already exists, then make it come to the front
+proc pdtk_canvas_raise {mytoplevel} {
+ wm deiconify $mytoplevel
+ raise $mytoplevel
+ set mycanvas $mytoplevel.c
focus $mycanvas
}
@@ -61,37 +145,71 @@ proc pdtk_canvas_saveas {name initialfile initialdir} {
set dirname [file dirname $filename]
set basename [file tail $filename]
pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
- set ::pd_menucommands::menu_new_dir $dirname
+ set ::filenewdir $dirname
+ # add to recentfiles
+ ::pd_guiprefs::update_recentfiles $filename
+}
+
+##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
+proc ::pdtk_canvas::pdtk_canvas_menuclose {mytoplevel reply_to_pd} {
+ raise $mytoplevel
+ set filename [wm title $mytoplevel]
+ set message [format {Do you want to save the changes you made in "%s"?} $filename]
+ set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
+ -parent $mytoplevel -icon question]
+ switch -- $answer {
+ yes {
+ pdsend "$mytoplevel menusave"
+ if {[regexp {Untitled-[0-9]+} $filename]} {
+ # wait until pdtk_canvas_saveas finishes and writes to
+ # this var, otherwise the close command will be sent
+ # immediately and the file won't get saved
+ vwait ::filenewdir
+ }
+ pdsend $reply_to_pd
+ }
+ no {pdsend $reply_to_pd}
+ cancel {}
+ }
}
#------------------------------------------------------------------------------#
# mouse usage
-proc pdtk_canvas_motion {mycanvas x y mods} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel motion [$mycanvas canvasx $x] [$mycanvas canvasy $y] $mods"
+# TODO put these procs into the pdtk_canvas namespace
+proc pdtk_canvas_motion {tkcanvas x y mods} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel motion [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $mods"
}
-proc pdtk_canvas_mouse {mycanvas x y b f} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b $f"
+proc pdtk_canvas_mouse {tkcanvas x y b f} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b $f"
}
-proc pdtk_canvas_mouseup {mycanvas x y b} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouseup [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b"
+proc pdtk_canvas_mouseup {tkcanvas x y b} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b"
}
-proc pdtk_canvas_rightclick {mycanvas x y b} {
- set mytoplevel [winfo toplevel $mycanvas]
- pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b 8"
+proc pdtk_canvas_rightclick {tkcanvas x y b} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ pdsend "$mytoplevel mouse [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b 8"
}
# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
-proc pdtk_canvas_clickpaste {mycanvas x y b} {
- pdtk_canvas_mouse $mycanvas $x $y $b 0
- pdtk_canvas_mouseup $mycanvas $x $y $b
- pdtk_pastetext
+proc pdtk_canvas_clickpaste {tkcanvas x y b} {
+ pdtk_canvas_mouse $tkcanvas $x $y $b 0
+ pdtk_canvas_mouseup $tkcanvas $x $y $b
+ if { [catch {set pdtk_pastebuffer [selection get]}] } {
+ # no selection... do nothing
+ } else {
+ for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
+ set cha [string index $pdtk_pastebuffer $i]
+ scan $cha %c keynum
+ pdsend "pd key 1 $keynum 0"
+ }
+ }
}
#------------------------------------------------------------------------------#
@@ -107,21 +225,21 @@ proc ::pdtk_canvas::create_popup {} {
# the popup menu for the canvas
menu .popup -tearoff false
.popup add command -label [_ "Properties"] \
- -command {popup_action $::focused_window 0}
+ -command {::pdtk_canvas::done_popup $::focused_window 0}
.popup add command -label [_ "Open"] \
- -command {popup_action $::focused_window 1}
+ -command {::pdtk_canvas::done_popup $::focused_window 1}
.popup add command -label [_ "Help"] \
- -command {popup_action $::focused_window 2}
+ -command {::pdtk_canvas::done_popup $::focused_window 2}
}
}
-proc popup_action {mytoplevel action} {
- pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
+proc ::pdtk_canvas::done_popup {mytoplevel action} {
+ pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas"
}
-proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
- set ::popup_xpix $xpix
- set ::popup_ypix $ypix
+proc ::pdtk_canvas::pdtk_canvas_popup {mytoplevel xcanvas ycanvas hasproperties hasopen} {
+ set ::popup_xcanvas $xcanvas
+ set ::popup_ycanvas $ycanvas
if {$hasproperties} {
.popup entryconfigure [_ "Properties"] -state normal
} else {
@@ -132,38 +250,137 @@ proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
} else {
.popup entryconfigure [_ "Open"] -state disabled
}
- set mycanvas "$mytoplevel.c"
- tk_popup .popup [expr $xpix + [winfo rootx $mycanvas]] \
- [expr $ypix + [winfo rooty $mycanvas]] 0
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ set scrollregion [$tkcanvas cget -scrollregion]
+ # get the canvas location that is currently the top left corner in the window
+ set left_xview_pix [expr [lindex [$tkcanvas xview] 0] * [lindex $scrollregion 2]]
+ set top_yview_pix [expr [lindex [$tkcanvas yview] 0] * [lindex $scrollregion 3]]
+ # take the mouse clicks in canvas coords, add the root of the canvas
+ # window, and subtract the area that is obscured by scrolling
+ set xpopup [expr int($xcanvas + [winfo rootx $tkcanvas] - $left_xview_pix)]
+ set ypopup [expr int($ycanvas + [winfo rooty $tkcanvas] - $top_yview_pix)]
+ tk_popup .popup $xpopup $ypopup 0
}
+#------------------------------------------------------------------------------#
+# procs for when file loading starts/finishes
+
+proc ::pdtk_canvas::started_loading_file {patchname} {
+ ::pdwindow::busygrab
+}
+
+# things to run when a patch is finished loading. This is called when
+# the OS sends the "Map" event for this window.
+proc ::pdtk_canvas::finished_loading_file {mytoplevel} {
+ # ::pdwindow::busyrelease is in pdtk_canvas_new so that the grab
+ # is released before the new toplevel window gets created.
+ # Otherwise the grab blocks the new window from getting the
+ # FocusIn event on creation.
+
+ # set editmode to make sure the menu item is in the right state
+ pdtk_canvas_editmode $mytoplevel $::editmode($mytoplevel)
+ set ::loaded($mytoplevel) 1
+ # send the virtual events now that everything is loaded
+ event generate $mytoplevel <<Loaded>>
+}
+
#------------------------------------------------------------------------------#
# procs for canvas events
# check or uncheck the "edit" menu item
-proc pdtk_canvas_editval {mytoplevel value} {
- set ::editmode($mytoplevel) $value
-# TODO figure how to change Edit Mode/Interact Mode text and have menu
-# enabling and disabling working still in pd_menus.tcl
-# if {$value == 0} {
-# $::pd_menus::menubar.edit entryconfigure [_ "Interact Mode"] -label [_ "Edit Mode"]
-# } else {
-# $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -label [_ "Interact Mode"]
-# }
- #$mytoplevel.menubar.edit entryconfigure [_ "Edit Mode"] -indicatoron $value
- # TODO make this work, probably with a proc in pd_menus, or maybe the menu
- # item can track the editmode variable
-}
-
-proc pdtk_undomenu {args} {
- # TODO make this work, probably with a proc in pd_menus
- puts "pdtk_undomenu $args"
-}
-
-proc pdtk_canvas_getscroll {mycanvas} {
- # TODO make this work
- # the C code still sends a .c canvas, so get the toplevel
- set mytoplevel [winfo toplevel $mycanvas]
- # puts stderr "pdtk_canvas_getscroll $mycanvas"
+proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} {
+ set ::editmode_button $state
+ set ::editmode($mytoplevel) $state
+ event generate $mytoplevel <<EditMode>>
+}
+
+# message from Pd to update the currently available undo/redo action
+proc pdtk_undomenu {mytoplevel undoaction redoaction} {
+ set ::undo_toplevel $mytoplevel
+ set ::undo_action $undoaction
+ set ::redo_action $redoaction
+ if {$mytoplevel ne "nobody"} {
+ ::pd_menus::update_undo_on_menu $mytoplevel
+ }
+}
+
+# This proc configures the scrollbars whenever anything relevant has
+# been updated. It should always receive a tkcanvas, which is then
+# used to generate the mytoplevel, needed to address the scrollbars.
+proc ::pdtk_canvas::pdtk_canvas_getscroll {tkcanvas} {
+ set mytoplevel [winfo toplevel $tkcanvas]
+ set bbox [$tkcanvas bbox all]
+ if {$bbox eq "" || [llength $bbox] != 4} {return}
+ set xupperleft [lindex $bbox 0]
+ set yupperleft [lindex $bbox 1]
+ if {$xupperleft > 0} {set xupperleft 0}
+ if {$yupperleft > 0} {set yupperleft 0}
+ set scrollregion [concat $xupperleft $yupperleft [lindex $bbox 2] [lindex $bbox 3]]
+ $tkcanvas configure -scrollregion $scrollregion
+ # X scrollbar
+ if {[lindex [$tkcanvas xview] 0] == 0.0 && [lindex [$tkcanvas xview] 1] == 1.0} {
+ set ::xscrollable($tkcanvas) 0
+ pack forget $mytoplevel.xscroll
+ } else {
+ set ::xscrollable($tkcanvas) 1
+ pack $mytoplevel.xscroll -side bottom -fill x -before $tkcanvas
+ }
+ # Y scrollbar, it gets touchy at the limit, so say > 0.995
+ if {[lindex [$tkcanvas yview] 0] == 0.0 && [lindex [$tkcanvas yview] 1] > 0.995} {
+ set ::yscrollable($tkcanvas) 0
+ pack forget $mytoplevel.yscroll
+ } else {
+ set ::yscrollable($tkcanvas) 1
+ pack $mytoplevel.yscroll -side right -fill y -before $tkcanvas
+ }
+}
+
+proc ::pdtk_canvas::scroll {tkcanvas axis amount} {
+ if {$axis eq "x" && $::xscrollable($tkcanvas) == 1} {
+ $tkcanvas xview scroll [expr {- ($amount)}] units
+ }
+ if {$axis eq "y" && $::yscrollable($tkcanvas) == 1} {
+ $tkcanvas yview scroll [expr {- ($amount)}] units
+ }
+}
+
+#------------------------------------------------------------------------------#
+# get patch window child/parent relationships
+
+# add a child window ID to the list of children, if it isn't already there
+proc ::pdtk_canvas::addchild {mytoplevel child} {
+ # if either ::childwindows($mytoplevel) does not exist, or $child does not
+ # exist inside of the ::childwindows($mytoplevel list
+ if { [lsearch -exact [array names ::childwindows $mytoplevel]] == -1 \
+ || [lsearch -exact $::childwindows($mytoplevel) $child] == -1} {
+ set ::childwindows($mytoplevel) [lappend ::childwindows($mytoplevel) $child]
+ }
+}
+
+# receive a list of all my parent windows from 'pd'
+proc ::pdtk_canvas::pdtk_canvas_setparents {mytoplevel args} {
+ set ::parentwindows($mytoplevel) $args
+ foreach parent $args {
+ addchild $parent $mytoplevel
+ }
+}
+
+# receive information for setting the info the the title bar of the window
+proc ::pdtk_canvas::pdtk_canvas_reflecttitle {mytoplevel \
+ path name arguments dirty} {
+ set ::windowname($mytoplevel) $name ;# TODO add path to this
+ if {$::windowingsystem eq "aqua"} {
+ wm attributes $mytoplevel -modified $dirty
+ if {[file exists "$path/$name"]} {
+ # for some reason -titlepath can still fail so just catch it
+ if [catch {wm attributes $mytoplevel -titlepath "$path/$name"}] {
+ wm title $mytoplevel "$path/$name"
+ }
+ }
+ wm title $mytoplevel "$name$arguments"
+ } else {
+ if {$dirty} {set dirtychar "*"} else {set dirtychar " "}
+ wm title $mytoplevel "$name$dirtychar$arguments - $path"
+ }
}
diff --git a/pd/tcl/pdtk_text.tcl b/pd/tcl/pdtk_text.tcl
index bb37ccc3c..b23ae0b26 100644
--- a/pd/tcl/pdtk_text.tcl
+++ b/pd/tcl/pdtk_text.tcl
@@ -1,20 +1,56 @@
package provide pdtk_text 0.1
-############ pdtk_text_new -- create a new text object #2###########
-proc pdtk_text_new {mycanvas canvasitem x y text font_size color} {
- $mycanvas create text $x $y -tags $canvasitem -text $text -fill $color \
+# these procs are currently all in the global namespace because all of them
+# are used by 'pd' and therefore need to be in the global namespace.
+
+# create a new text object (ie. obj, msg, comment)
+proc pdtk_text_new {tkcanvas tags x y text font_size color} {
+ $tkcanvas create text $x $y -tags $tags -text $text -fill $color \
-anchor nw -font [get_font_for_size $font_size]
- $mycanvas bind $canvasitem <Home> "$mycanvas icursor $canvasitem 0"
- $mycanvas bind $canvasitem <End> "$mycanvas icursor $canvasitem end"
+ set mytag [lindex $tags 0]
+ $tkcanvas bind $mytag <Home> "$tkcanvas icursor $mytag 0"
+ $tkcanvas bind $mytag <End> "$tkcanvas icursor $mytag end"
+ # select all
+ $tkcanvas bind $mytag <Triple-ButtonRelease-1> \
+ "pdtk_text_selectall $tkcanvas $mytag"
if {$::windowingsystem eq "aqua"} { # emacs bindings for Mac OS X
- $mycanvas bind $canvasitem <Control-a> "$mycanvas icursor $canvasitem 0"
- $mycanvas bind $canvasitem <Control-e> "$mycanvas icursor $canvasitem end"
+ $tkcanvas bind $mytag <Control-a> "$tkcanvas icursor $mytag 0"
+ $tkcanvas bind $mytag <Control-e> "$tkcanvas icursor $mytag end"
+ }
+}
+
+# change the text in an existing text box
+proc pdtk_text_set {tkcanvas tag text} {
+ $tkcanvas itemconfig $tag -text $text
+}
+
+# paste into an existing text box by literally "typing" the contents of the
+# clipboard, i.e. send the contents one character at a time via 'pd key'
+proc pdtk_pastetext {args} {
+ if { [catch {set pdtk_pastebuffer [clipboard get]}] } {
+ # no selection... do nothing
+ } else {
+ for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
+ set cha [string index $pdtk_pastebuffer $i]
+ scan $cha %c keynum
+ pdsend "pd key 1 $keynum 0"
+ }
}
}
-################ pdtk_text_set -- change the text ##################
-proc pdtk_text_set {mycanvas canvasitem text} {
- $mycanvas itemconfig $canvasitem -text $text
+# select all of the text in an existing text box
+proc pdtk_text_selectall {tkcanvas mytag} {
+ if {$::editmode([winfo toplevel $tkcanvas])} {
+ $tkcanvas select from $mytag 0
+ $tkcanvas select to $mytag end
+ }
}
+# de/activate a text box for editing based on $editing flag
+proc pdtk_text_editing {mytoplevel tag editing} {
+ set tkcanvas [tkcanvas_name $mytoplevel]
+ if {$editing == 0} {selection clear $tkcanvas}
+ $tkcanvas focus $tag
+ set ::editingtext($mytoplevel) $editing
+}
diff --git a/pd/tcl/pdtk_textwindow.tcl b/pd/tcl/pdtk_textwindow.tcl
new file mode 100644
index 000000000..4d7e28224
--- /dev/null
+++ b/pd/tcl/pdtk_textwindow.tcl
@@ -0,0 +1,103 @@
+# Copyright (c) 2002-2012 krzYszcz and others.
+# For information on usage and redistribution, and for a DISCLAIMER OF ALL
+# WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
+
+# pdtk_textwindow - a window containing scrollable text for "qlist" and
+# "textfile" objects - later the latter might get renamed just "text"
+
+# this is adapted from krzYszcz's code for coll in cyclone
+
+package provide pdtk_textwindow 0.1
+
+# these procs are currently all in the global namespace because they're
+# called from pd.
+
+proc pdtk_textwindow_open {name geometry title font} {
+ if {[winfo exists $name]} {
+ $name.text delete 1.0 end
+ } else {
+ toplevel $name
+ wm title $name $title
+ wm geometry $name $geometry
+ wm protocol $name WM_DELETE_WINDOW \
+ [concat pdtk_textwindow_close $name 1]
+ bind $name <<Modified>> "pdtk_textwindow_dodirty $name"
+ text $name.text -relief raised -bd 2 \
+ -font [get_font_for_size $font] \
+ -yscrollcommand "$name.scroll set" -background white
+ scrollbar $name.scroll -command "$name.text yview"
+ pack $name.scroll -side right -fill y
+ pack $name.text -side left -fill both -expand 1
+ bind $name.text <$::modifier-Key-s> "pdtk_textwindow_send $name"
+ bind $name.text <$::modifier-Key-w> "pdtk_textwindow_close $name 1"
+ focus $name.text
+ }
+}
+
+proc pdtk_textwindow_dodirty {name} {
+ if {[catch {$name.text edit modified} dirty]} {set dirty 1}
+ set title [wm title $name]
+ set dt [string equal -length 1 $title "*"]
+ if {$dirty} {
+ if {$dt == 0} {wm title $name *$title}
+ } else {
+ if {$dt} {wm title $name [string range $title 1 end]}
+ }
+}
+
+proc pdtk_textwindow_setdirty {name flag} {
+ if {[winfo exists $name]} {
+ catch {$name.text edit modified $flag}
+ }
+}
+
+proc pdtk_textwindow_doclose {name} {
+ destroy $name
+ pdsend [concat $name signoff]
+}
+
+proc pdtk_textwindow_append {name contents} {
+ if {[winfo exists $name]} {
+ $name.text insert end $contents
+ }
+}
+
+proc pdtk_textwindow_clear {name} {
+ if {[winfo exists $name]} {
+ $name.text delete 1.0 end
+ }
+}
+
+proc pdtk_textwindow_send {name} {
+ if {[winfo exists $name]} {
+ pdsend [concat $name clear]
+ for {set i 1} \
+ {[$name.text compare $i.end < end]} \
+ {incr i 1} {
+ set lin [$name.text get $i.0 $i.end]
+ if {$lin != ""} {
+ regsub -all \; $lin " \\; " tmplin
+ regsub -all \, $tmplin " \\, " lin
+ pdsend [concat $name addline $lin]
+ }
+ }
+ }
+ pdtk_textwindow_setdirty $name 0
+}
+
+proc pdtk_textwindow_close {name ask} {
+ if {[winfo exists $name]} {
+ if {[catch {$name.text edit modified} dirty]} {set dirty 1}
+ if {$ask && $dirty} {
+ set title [wm title $name]
+ if {[string equal -length 1 $title "*"]} {
+ set title [string range $title 1 end]
+ }
+ set answer [tk_messageBox \-type yesnocancel \
+ \-icon question \
+ \-message [concat Save changes to \"$title\"?]]
+ if {$answer == "yes"} {pdtk_textwindow_send $name}
+ if {$answer != "cancel"} {pdsend [concat $name close]}
+ } else {pdsend [concat $name close]}
+ }
+}
diff --git a/pd/tcl/pdwindow.tcl b/pd/tcl/pdwindow.tcl
index d0c0c654b..7409bf317 100644
--- a/pd/tcl/pdwindow.tcl
+++ b/pd/tcl/pdwindow.tcl
@@ -2,52 +2,399 @@
package provide pdwindow 0.1
namespace eval ::pdwindow:: {
- variable consolefont
- variable printout_buffer ""
- variable pdwindow_search_index
+ variable logbuffer {}
+ variable tclentry {}
+ variable tclentry_history {"console show"}
+ variable history_position 0
+ variable linecolor 0 ;# is toggled to alternate text line colors
+ variable logmenuitems
+ variable maxloglevel 4
+ variable lastlevel 0
+
+ namespace export create_window
namespace export pdtk_post
+ namespace export pdtk_pd_dsp
+ namespace export pdtk_pd_dio
+}
+
+# TODO make the Pd window save its size and location between running
+
+proc ::pdwindow::set_layout {} {
+ variable maxloglevel
+ .pdwindow.text.internal tag configure log0 -foreground "#d00" -background "#ffe0e8"
+ .pdwindow.text.internal tag configure log1 -foreground "#d00"
+ # log2 messages are normal black on white
+ .pdwindow.text.internal tag configure log3 -foreground "#484848"
+
+ # 0-20(4-24) is a rough useful range of 'verbose' levels for impl debugging
+ set start 4
+ set end 25
+ for {set i $start} {$i < $end} {incr i} {
+ set B [expr int(($i - $start) * (40 / ($end - $start))) + 50]
+ .pdwindow.text.internal tag configure log${i} -foreground grey${B}
+ }
+}
+
+
+# grab focus on part of the Pd window when Pd is busy
+proc ::pdwindow::busygrab {} {
+ # set the mouse cursor to look busy and grab focus so it stays that way
+ .pdwindow.text configure -cursor watch
+ grab set .pdwindow.text
+}
+
+# release focus on part of the Pd window when Pd is finished
+proc ::pdwindow::busyrelease {} {
+ .pdwindow.text configure -cursor xterm
+ grab release .pdwindow.text
}
+# ------------------------------------------------------------------------------
+# pdtk functions for 'pd' to send data to the Pd window
+proc ::pdwindow::buffer_message {object_id level message} {
+ variable logbuffer
+ lappend logbuffer $object_id $level $message
+}
-proc ::pdwindow::pdtk_post {message} {
- variable printout_buffer
- # TODO this should be switchable between Pd window and stderr
- if { ! [winfo exists .pdwindow.text]} {
- set printout_buffer "$printout_buffer\n$message"
+proc ::pdwindow::insert_log_line {object_id level message} {
+ if {$object_id eq ""} {
+ .pdwindow.text.internal insert end $message log$level
} else {
- if {$printout_buffer ne ""} {
- .pdwindow.text insert end "$printout_buffer\n"
- set printout_buffer ""
+ .pdwindow.text.internal insert end $message [list log$level obj$object_id]
+ .pdwindow.text.internal tag bind obj$object_id <$::modifier-ButtonRelease-1> \
+ "::pdwindow::select_by_id $object_id; break"
+ .pdwindow.text.internal tag bind obj$object_id <Key-Return> \
+ "::pdwindow::select_by_id $object_id; break"
+ .pdwindow.text.internal tag bind obj$object_id <Key-KP_Enter> \
+ "::pdwindow::select_by_id $object_id; break"
+ }
+}
+
+# this has 'args' to satisfy trace, but its not used
+proc ::pdwindow::filter_buffer_to_text {args} {
+ variable logbuffer
+ variable maxloglevel
+ .pdwindow.text.internal delete 0.0 end
+ set i 0
+ foreach {object_id level message} $logbuffer {
+ if { $level <= $::loglevel || $maxloglevel == $::loglevel} {
+ insert_log_line $object_id $level $message
}
- .pdwindow.text insert end "$message\n"
- .pdwindow.text yview end
+ # this could take a while, so update the GUI every 10000 lines
+ if { [expr $i % 10000] == 0} {update idletasks}
+ incr i
+ }
+ .pdwindow.text.internal yview end
+ ::pdwindow::verbose 10 "The Pd window filtered $i lines\n"
+}
+
+proc ::pdwindow::select_by_id {args} {
+ if [llength $args] { # Is $args empty?
+ pdsend "pd findinstance $args"
+ }
+}
+
+# logpost posts to Pd window with an object to trace back to and a
+# 'log level'. The logpost and related procs are for generating
+# messages that are useful for debugging patches. They are messages
+# that are meant for the Pd programmer to see so that they can get
+# information about the patches they are building
+proc ::pdwindow::logpost {object_id level message} {
+ variable maxloglevel
+ variable lastlevel $level
+
+ buffer_message $object_id $level $message
+ if {[llength [info commands .pdwindow.text.internal]] &&
+ ($level <= $::loglevel || $maxloglevel == $::loglevel)} {
+ # cancel any pending move of the scrollbar, and schedule it
+ # after writing a line. This way the scrollbar is only moved once
+ # when the inserting has finished, greatly speeding things up
+ after cancel .pdwindow.text.internal yview end
+ insert_log_line $object_id $level $message
+ after idle .pdwindow.text.internal yview end
}
- puts stderr $message
+ # -stderr only sets $::stderr if 'pd-gui' is started before 'pd'
+ if {$::stderr} {puts stderr $message}
}
+# shortcuts for posting to the Pd window
+proc ::pdwindow::fatal {message} {logpost {} 0 $message}
+proc ::pdwindow::error {message} {logpost {} 1 $message}
+proc ::pdwindow::post {message} {logpost {} 2 $message}
+proc ::pdwindow::debug {message} {logpost {} 3 $message}
+# for backwards compatibility
+proc ::pdwindow::bug {message} {logpost {} 3 $message}
+proc ::pdwindow::pdtk_post {message} {post $message}
+
+proc ::pdwindow::endpost {} {
+ variable linecolor
+ variable lastlevel
+ logpost {} $lastlevel "\n"
+ set linecolor [expr ! $linecolor]
+}
+
+# this verbose proc has a separate numbering scheme since its for
+# debugging implementations, and therefore falls outside of the 0-3
+# numbering on the Pd window. They should only be shown in ALL mode.
+proc ::pdwindow::verbose {level message} {
+ incr level 4
+ logpost {} $level $message
+}
+
+# clear the log and the buffer
+proc ::pdwindow::clear_console {} {
+ variable logbuffer {}
+ .pdwindow.text.internal delete 0.0 end
+}
+
+# save the contents of the pdwindow::logbuffer to a file
+proc ::pdwindow::save_logbuffer_to_file {} {
+ variable logbuffer
+ set filename [tk_getSaveFile -initialfile "pdwindow.txt" -defaultextension .txt]
+ if {$filename eq ""} return; # they clicked cancel
+ set f [open $filename w]
+ puts $f "Pd $::PD_MAJOR_VERSION.$::PD_MINOR_VERSION.$::PD_BUGFIX_VERSION.$::PD_TEST_VERSION on $::windowingsystem"
+ puts $f "Tcl/Tk [info patchlevel]"
+ puts $f "------------------------------------------------------------------------------"
+ puts $f $logbuffer
+ close $f
+}
+
+
+#--compute audio/DSP checkbutton-----------------------------------------------#
+
+# set the checkbox on the "Compute Audio" menuitem and checkbox
+proc ::pdwindow::pdtk_pd_dsp {value} {
+ # TODO canvas_startdsp/stopdsp should really send 1 or 0, not "ON" or "OFF"
+ if {$value eq "ON"} {
+ set ::dsp 1
+ } else {
+ set ::dsp 0
+ }
+}
+
+proc ::pdwindow::pdtk_pd_dio {red} {
+ if {$red == 1} {
+ .pdwindow.header.dio configure -foreground red
+ } else {
+ .pdwindow.header.dio configure -foreground lightgray
+ }
+
+}
+
+#--bindings specific to the Pd window------------------------------------------#
+
+proc ::pdwindow::pdwindow_bindings {} {
+ # these bindings are for the whole Pd window, minus the Tcl entry
+ foreach window {.pdwindow.text .pdwindow.header} {
+ bind $window <$::modifier-Key-x> "tk_textCut .pdwindow.text"
+ bind $window <$::modifier-Key-c> "tk_textCopy .pdwindow.text"
+ bind $window <$::modifier-Key-v> "tk_textPaste .pdwindow.text"
+ }
+ # Select All doesn't seem to work unless its applied to the whole window
+ bind .pdwindow <$::modifier-Key-a> ".pdwindow.text tag add sel 1.0 end"
+ # the "; break" part stops executing another binds, like from the Text class
+
+ # these don't do anything in the Pd window, so alert the user, then break
+ # so no more bindings run
+ bind .pdwindow <$::modifier-Key-s> "bell; break"
+ bind .pdwindow <$::modifier-Key-p> "bell; break"
+
+ # ways of hiding/closing the Pd window
+ if {$::windowingsystem eq "aqua"} {
+ # on Mac OS X, you can close the Pd window, since the menubar is there
+ bind .pdwindow <$::modifier-Key-w> "wm withdraw .pdwindow"
+ wm protocol .pdwindow WM_DELETE_WINDOW "wm withdraw .pdwindow"
+ } else {
+ # TODO should it possible to close the Pd window and keep Pd open?
+ bind .pdwindow <$::modifier-Key-w> "wm iconify .pdwindow"
+ wm protocol .pdwindow WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
+ }
+}
+
+#--Tcl entry procs-------------------------------------------------------------#
+
+proc ::pdwindow::eval_tclentry {} {
+ variable tclentry
+ variable tclentry_history
+ variable history_position 0
+ if {$tclentry eq ""} {return} ;# no need to do anything if empty
+ if {[catch {uplevel #0 $tclentry} errorname]} {
+ global errorInfo
+ switch -regexp -- $errorname {
+ "missing close-brace" {
+ ::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACE '\}': "] $errorInfo]\n
+ } "missing close-bracket" {
+ ::pdwindow::error [concat [_ "(Tcl) MISSING CLOSE-BRACKET '\]': "] $errorInfo]\n
+ } "^invalid command name" {
+ ::pdwindow::error [concat [_ "(Tcl) INVALID COMMAND NAME: "] $errorInfo]\n
+ } default {
+ ::pdwindow::error [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo]\n
+ }
+ }
+ }
+ lappend tclentry_history $tclentry
+ set tclentry {}
+}
+
+proc ::pdwindow::get_history {direction} {
+ variable tclentry_history
+ variable history_position
+
+ incr history_position $direction
+ if {$history_position < 0} {set history_position 0}
+ if {$history_position > [llength $tclentry_history]} {
+ set history_position [llength $tclentry_history]
+ }
+ .pdwindow.tcl.entry delete 0 end
+ .pdwindow.tcl.entry insert 0 \
+ [lindex $tclentry_history end-[expr $history_position - 1]]
+}
+
+proc ::pdwindow::validate_tcl {} {
+ variable tclentry
+ if {[info complete $tclentry]} {
+ .pdwindow.tcl.entry configure -background "white"
+ } else {
+ .pdwindow.tcl.entry configure -background "#FFF0F0"
+ }
+}
+
+#--create tcl entry-----------------------------------------------------------#
+
+proc ::pdwindow::create_tcl_entry {} {
+# Tcl entry box frame
+ label .pdwindow.tcl.label -text [_ "Tcl:"] -anchor e
+ pack .pdwindow.tcl.label -side left
+ entry .pdwindow.tcl.entry -width 200 \
+ -exportselection 1 -insertwidth 2 -insertbackground blue \
+ -textvariable ::pdwindow::tclentry -font {$::font_family 12}
+ pack .pdwindow.tcl.entry -side left -fill x
+# bindings for the Tcl entry widget
+ bind .pdwindow.tcl.entry <$::modifier-Key-a> "%W selection range 0 end; break"
+ bind .pdwindow.tcl.entry <Return> "::pdwindow::eval_tclentry"
+ bind .pdwindow.tcl.entry <Up> "::pdwindow::get_history 1"
+ bind .pdwindow.tcl.entry <Down> "::pdwindow::get_history -1"
+ bind .pdwindow.tcl.entry <KeyRelease> +"::pdwindow::validate_tcl"
+
+ bind .pdwindow.text <Key-Tab> "focus .pdwindow.tcl.entry; break"
+}
+
+proc ::pdwindow::set_findinstance_cursor {widget key state} {
+ set triggerkeys [list Control_L Control_R Meta_L Meta_R]
+ if {[lsearch -exact $triggerkeys $key] > -1} {
+ if {$state == 0} {
+ $widget configure -cursor xterm
+ } else {
+ $widget configure -cursor based_arrow_up
+ }
+ }
+}
+
+#--create the window-----------------------------------------------------------#
+
proc ::pdwindow::create_window {} {
- variable consolefont
+ variable logmenuitems
+ set ::loaded(.pdwindow) 0
+
+ # colorize by class before creating anything
+ option add *PdWindow*Entry.highlightBackground "grey" startupFile
+ option add *PdWindow*Frame.background "grey" startupFile
+ option add *PdWindow*Label.background "grey" startupFile
+ option add *PdWindow*Checkbutton.background "grey" startupFile
+ option add *PdWindow*Menubutton.background "grey" startupFile
+ option add *PdWindow*Text.background "white" startupFile
+ option add *PdWindow*Entry.background "white" startupFile
+
toplevel .pdwindow -class PdWindow
- wm title .pdwindow [_ "Pd window"]
- wm geometry .pdwindow =500x450+20+50
+ wm title .pdwindow [_ "Pd"]
+ set ::windowname(.pdwindow) [_ "Pd"]
+ if {$::windowingsystem eq "x11"} {
+ wm minsize .pdwindow 400 75
+ } else {
+ wm minsize .pdwindow 400 51
+ }
+ wm geometry .pdwindow =500x400+20+50
.pdwindow configure -menu .menubar
- ::pd_menus::configure_for_pdwindow
- ::pd_bindings::pdwindow_bindings .pdwindow
- frame .pdwindow.header
- pack .pdwindow.header -side top -fill x -padx 30 -ipady 10
- # label .pdwindow.header.label -text "The Pd window wants you to make it look nice!"
- # pack .pdwindow.header.label -side left -fill y -anchor w
+ frame .pdwindow.header -borderwidth 1 -relief flat -background lightgray
+ pack .pdwindow.header -side top -fill x -ipady 5
+
+ frame .pdwindow.header.pad1
+ pack .pdwindow.header.pad1 -side left -padx 12
+
checkbutton .pdwindow.header.dsp -text [_ "DSP"] -variable ::dsp \
- -command "pdsend \"pd dsp 0\""
- pack .pdwindow.header.dsp -side right -fill y -anchor e
+ -font {$::font_family 18 bold} -takefocus 1 -background lightgray \
+ -borderwidth 0 -command {pdsend "pd dsp $::dsp"}
+ pack .pdwindow.header.dsp -side right -fill y -anchor e -padx 5 -pady 0
+# DIO button
+ label .pdwindow.header.dio -text [_ "audio I/O error"] -borderwidth 0 \
+ -background lightgray -foreground lightgray \
+ -takefocus 0 \
+ -font {$::font_family 14}
+ pack .pdwindow.header.dio -side right -fill y -padx 30 -pady 0
+
+ label .pdwindow.header.loglabel -text [_ "Log:"] -anchor e \
+ -background lightgray
+ pack .pdwindow.header.loglabel -side left
+
+ set loglevels {0 1 2 3 4}
+ lappend logmenuitems "0 [_ fatal]"
+ lappend logmenuitems "1 [_ error]"
+ lappend logmenuitems "2 [_ normal]"
+ lappend logmenuitems "3 [_ debug]"
+ lappend logmenuitems "4 [_ all]"
+ set logmenu \
+ [eval tk_optionMenu .pdwindow.header.logmenu ::loglevel $loglevels]
+ .pdwindow.header.logmenu configure -background lightgray
+ foreach i $loglevels {
+ $logmenu entryconfigure $i -label [lindex $logmenuitems $i]
+ }
+ trace add variable ::loglevel write ::pdwindow::filter_buffer_to_text
+
+ # TODO figure out how to make the menu traversable with the keyboard
+ #.pdwindow.header.logmenu configure -takefocus 1
+ pack .pdwindow.header.logmenu -side left
+ frame .pdwindow.tcl -borderwidth 0
+ pack .pdwindow.tcl -side bottom -fill x
# TODO this should use the pd_font_$size created in pd-gui.tcl
text .pdwindow.text -relief raised -bd 2 -font {-size 10} \
- -yscrollcommand ".pdwindow.scroll set" -width 60
- scrollbar .pdwindow.scroll -command ".pdwindow.text yview"
+ -highlightthickness 0 -borderwidth 1 -relief flat \
+ -yscrollcommand ".pdwindow.scroll set" -width 60 \
+ -undo false -autoseparators false -maxundo 1 -takefocus 0
+ scrollbar .pdwindow.scroll -command ".pdwindow.text.internal yview"
pack .pdwindow.scroll -side right -fill y
- pack .pdwindow.text -side bottom -fill both -expand 1
+ pack .pdwindow.text -side right -fill both -expand 1
raise .pdwindow
+ focus .pdwindow.text
+ # run bindings last so that .pdwindow.tcl.entry exists
+ pdwindow_bindings
+ # set cursor to show when clicking in 'findinstance' mode
+ bind .pdwindow <KeyPress> "+::pdwindow::set_findinstance_cursor %W %K %s"
+ bind .pdwindow <KeyRelease> "+::pdwindow::set_findinstance_cursor %W %K %s"
+
+ # hack to make a good read-only text widget from http://wiki.tcl.tk/1152
+ rename ::.pdwindow.text ::.pdwindow.text.internal
+ proc ::.pdwindow.text {args} {
+ switch -exact -- [lindex $args 0] {
+ "insert" {}
+ "delete" {}
+ "default" { return [eval ::.pdwindow.text.internal $args] }
+ }
+ }
+
+ # print whatever is in the queue after the event loop finishes
+ after idle [list after 0 ::pdwindow::filter_buffer_to_text]
+
+ set ::loaded(.pdwindow) 1
+
+ # set some layout variables
+ ::pdwindow::set_layout
+
+ # wait until .pdwindow.tcl.entry is visible before opening files so that
+ # the loading logic can grab it and put up the busy cursor
+ tkwait visibility .pdwindow.text
+# create_tcl_entry
}
diff --git a/pd/tcl/pkgIndex.tcl b/pd/tcl/pkgIndex.tcl
index cd28c6bd0..55322377d 100644
--- a/pd/tcl/pkgIndex.tcl
+++ b/pd/tcl/pkgIndex.tcl
@@ -14,15 +14,24 @@ package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]]
package ifneeded dialog_array 0.1 [list source [file join $dir dialog_array.tcl]]
package ifneeded dialog_audio 0.1 [list source [file join $dir dialog_audio.tcl]]
package ifneeded dialog_canvas 0.1 [list source [file join $dir dialog_canvas.tcl]]
+package ifneeded dialog_data 0.1 [list source [file join $dir dialog_data.tcl]]
package ifneeded dialog_find 0.1 [list source [file join $dir dialog_find.tcl]]
package ifneeded dialog_font 0.1 [list source [file join $dir dialog_font.tcl]]
package ifneeded dialog_gatom 0.1 [list source [file join $dir dialog_gatom.tcl]]
package ifneeded dialog_iemgui 0.1 [list source [file join $dir dialog_iemgui.tcl]]
+package ifneeded dialog_message 0.1 [list source [file join $dir dialog_message.tcl]]
package ifneeded dialog_midi 0.1 [list source [file join $dir dialog_midi.tcl]]
+package ifneeded dialog_path 0.1 [list source [file join $dir dialog_path.tcl]]
+package ifneeded dialog_startup 0.1 [list source [file join $dir dialog_startup.tcl]]
+package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
package ifneeded opt_parser 0.1 [list source [file join $dir opt_parser.tcl]]
+package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]]
package ifneeded pdwindow 0.1 [list source [file join $dir pdwindow.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 pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]]
package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]]
+package ifneeded pdtk_textwindow 0.1 [list source [file join $dir pdtk_textwindow.tcl]]
+package ifneeded scrollbox 0.1 [list source [file join $dir scrollbox.tcl]]
+package ifneeded scrollboxwindow 0.1 [list source [file join $dir scrollboxwindow.tcl]]
package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
diff --git a/pd/tcl/scrollbox.tcl b/pd/tcl/scrollbox.tcl
new file mode 100644
index 000000000..b06670a0c
--- /dev/null
+++ b/pd/tcl/scrollbox.tcl
@@ -0,0 +1,191 @@
+######### scrollbox -- utility scrollbar with default bindings #######
+# scrollbox is used in the Path and Startup dialogs to edit lists of options
+
+package provide scrollbox 0.1
+
+namespace eval scrollbox {
+ # This variable keeps track of the last list element we clicked on,
+ # used to implement drag-drop reordering of list items
+ variable lastIdx 0
+}
+
+proc ::scrollbox::get_curidx { mytoplevel } {
+ set idx [$mytoplevel.listbox.box index active]
+ if {$idx < 0 || \
+ $idx == [$mytoplevel.listbox.box index end]} {
+ return [expr {[$mytoplevel.listbox.box index end] + 1}]
+ }
+ return [expr $idx]
+}
+
+proc ::scrollbox::insert_item { mytoplevel idx name } {
+ if {$name != ""} {
+ $mytoplevel.listbox.box insert $idx $name
+ set activeIdx [expr {[$mytoplevel.listbox.box index active] + 1}]
+ $mytoplevel.listbox.box see $activeIdx
+ $mytoplevel.listbox.box activate $activeIdx
+ $mytoplevel.listbox.box selection clear 0 end
+ $mytoplevel.listbox.box selection set active
+ focus $mytoplevel.listbox.box
+ }
+}
+
+proc ::scrollbox::add_item { mytoplevel add_method } {
+ set dir [$add_method]
+ insert_item $mytoplevel [expr {[get_curidx $mytoplevel] + 1}] $dir
+}
+
+proc ::scrollbox::edit_item { mytoplevel edit_method } {
+ set idx [expr {[get_curidx $mytoplevel]}]
+ set initialValue [$mytoplevel.listbox.box get $idx]
+ if {$initialValue != ""} {
+ set dir [$edit_method $initialValue]
+
+ if {$dir != ""} {
+ $mytoplevel.listbox.box delete $idx
+ insert_item $mytoplevel $idx $dir
+ }
+ $mytoplevel.listbox.box activate $idx
+ $mytoplevel.listbox.box selection clear 0 end
+ $mytoplevel.listbox.box selection set active
+ focus $mytoplevel.listbox.box
+ }
+}
+
+proc ::scrollbox::delete_item { mytoplevel } {
+ set cursel [$mytoplevel.listbox.box curselection]
+ foreach idx $cursel {
+ $mytoplevel.listbox.box delete $idx
+ }
+}
+
+# Double-clicking on the listbox should edit the current item,
+# or add a new one if there is no current
+proc ::scrollbox::dbl_click { mytoplevel edit_method add_method x y } {
+ if { $x == "" || $y == "" } {
+ return
+ }
+
+ set curBB [$mytoplevel.listbox.box bbox @$x,$y]
+
+ # listbox bbox returns an array of 4 items in the order:
+ # left, top, width, height
+ set height [lindex $curBB 3]
+ set top [lindex $curBB 1]
+ if { $height == "" || $top == "" } {
+ # If for some reason we didn't get valid bbox info,
+ # we want to default to adding a new item
+ set height 0
+ set top 0
+ set y 1
+ }
+
+ set bottom [expr {$height + $top}]
+
+ if {$y > $bottom} {
+ add_item $mytoplevel $add_method
+ } else {
+ edit_item $mytoplevel $edit_method
+ }
+}
+
+proc ::scrollbox::click { mytoplevel x y } {
+ # record the index of the current element being
+ # clicked on
+ variable ::lastIdx [$mytoplevel.listbox.box index @$x,$y]
+
+ focus $mytoplevel.listbox.box
+}
+
+# For drag-and-drop reordering, recall the last-clicked index
+# and move it to the position of the item currently under the mouse
+proc ::scrollbox::release { mytoplevel x y } {
+ variable lastIdx
+ set curIdx [$mytoplevel.listbox.box index @$x,$y]
+
+ if { $curIdx != $::lastIdx } {
+ # clear any current selection
+ $mytoplevel.listbox.box selection clear 0 end
+
+ set oldIdx $::lastIdx
+ set newIdx [expr {$curIdx+1}]
+ set selIdx $curIdx
+
+ if { $curIdx < $::lastIdx } {
+ set oldIdx [expr {$::lastIdx + 1}]
+ set newIdx $curIdx
+ set selIdx $newIdx
+ }
+
+ $mytoplevel.listbox.box insert $newIdx [$mytoplevel.listbox.box get $::lastIdx]
+ $mytoplevel.listbox.box delete $oldIdx
+ $mytoplevel.listbox.box activate $newIdx
+ $mytoplevel.listbox.box selection set $selIdx
+ }
+}
+
+# Make a scrollbox widget in a given window and set of data.
+#
+# id - the parent window for the scrollbox
+# listdata - array of data to populate the scrollbox
+# add_method - method to be called when we add a new item
+# edit_method - method to be called when we edit an existing item
+proc ::scrollbox::make { mytoplevel listdata add_method edit_method } {
+ frame $mytoplevel.listbox
+ listbox $mytoplevel.listbox.box \
+ -selectmode browse -activestyle dotbox \
+ -yscrollcommand [list "$mytoplevel.listbox.scrollbar" set]
+
+ # Create a scrollbar and keep it in sync with the current
+ # listbox view
+ pack $mytoplevel.listbox.box [scrollbar "$mytoplevel.listbox.scrollbar" \
+ -command [list $mytoplevel.listbox.box yview]] \
+ -side left -fill y -anchor w
+
+ # Populate the listbox widget
+ foreach item $listdata {
+ $mytoplevel.listbox.box insert end $item
+ }
+
+ # Standard listbox key/mouse bindings
+ event add <<Delete>> <Delete>
+ if { $::windowingsystem eq "aqua" } { event add <<Delete>> <BackSpace> }
+
+ bind $mytoplevel.listbox.box <ButtonPress> "::scrollbox::click $mytoplevel %x %y"
+ bind $mytoplevel.listbox.box <Double-1> "::scrollbox::dbl_click $mytoplevel $edit_method $add_method %x %y"
+ bind $mytoplevel.listbox.box <ButtonRelease> "::scrollbox::release $mytoplevel %x %y"
+ bind $mytoplevel.listbox.box <Return> "::scrollbox::edit_item $mytoplevel $edit_method"
+ bind $mytoplevel.listbox.box <<Delete>> "::scrollbox::delete_item $mytoplevel"
+
+ # <Configure> is called when the user modifies the window
+ # We use it to capture resize events, to make sure the
+ # currently selected item in the listbox is always visible
+ bind $mytoplevel <Configure> "$mytoplevel.listbox.box see active"
+
+ # The listbox should expand to fill its containing window
+ # the "-fill" option specifies which direction (x, y or both) to fill, while
+ # the "-expand" option (false by default) specifies whether the widget
+ # should fill
+ pack $mytoplevel.listbox.box -side left -fill both -expand 1
+ pack $mytoplevel.listbox -side top -pady 2m -padx 2m -fill both -expand 1
+
+ # All widget interactions can be performed without buttons, but
+ # we still need a "New..." button since the currently visible window
+ # might be full (even though the user can still expand it)
+ frame $mytoplevel.actions
+ pack $mytoplevel.actions -side top -padx 2m -fill x
+ button $mytoplevel.actions.add_path -text {New...} \
+ -command "::scrollbox::add_item $mytoplevel $add_method"
+ button $mytoplevel.actions.edit_path -text {Edit...} \
+ -command "::scrollbox::edit_item $mytoplevel $edit_method"
+ button $mytoplevel.actions.delete_path -text {Delete} \
+ -command "::scrollbox::delete_item $mytoplevel"
+
+ pack $mytoplevel.actions.delete_path -side right -pady 2m
+ pack $mytoplevel.actions.edit_path -side right -pady 2m
+ pack $mytoplevel.actions.add_path -side right -pady 2m
+
+ $mytoplevel.listbox.box activate end
+ $mytoplevel.listbox.box selection set end
+ focus $mytoplevel.listbox.box
+}
diff --git a/pd/tcl/scrollboxwindow.tcl b/pd/tcl/scrollboxwindow.tcl
new file mode 100644
index 000000000..d78622c66
--- /dev/null
+++ b/pd/tcl/scrollboxwindow.tcl
@@ -0,0 +1,94 @@
+
+####### scrollboxwindow -- scrollbox window with default bindings #########
+## This is the base dialog behind the Path and Startup dialogs
+## This namespace specifies everything the two dialogs have in common,
+## with arguments specifying the differences
+##
+## By default, this creates a dialog centered on the viewing area of the screen
+## with cancel, apply, and OK buttons
+## which contains a scrollbox widget populated with the given data
+
+package provide scrollboxwindow 0.1
+
+package require scrollbox
+
+namespace eval scrollboxwindow {
+}
+
+
+proc ::scrollboxwindow::get_listdata {mytoplevel} {
+ return [$mytoplevel.listbox.box get 0 end]
+}
+
+proc ::scrollboxwindow::do_apply {mytoplevel commit_method listdata} {
+ $commit_method [pdtk_encode $listdata]
+ pdsend "pd save-preferences"
+}
+
+# Cancel button action
+proc ::scrollboxwindow::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+# Apply button action
+proc ::scrollboxwindow::apply {mytoplevel commit_method } {
+ do_apply $mytoplevel $commit_method [get_listdata $mytoplevel]
+}
+
+# OK button action
+# The "commit" action can take a second or more,
+# long enough to be noticeable, so we only write
+# the changes after closing the dialog
+proc ::scrollboxwindow::ok {mytoplevel commit_method } {
+ set listdata [get_listdata $mytoplevel]
+ cancel $mytoplevel
+ do_apply $mytoplevel $commit_method $listdata
+}
+
+# "Constructor" function for building the window
+# id -- the window id to use
+# listdata -- the data used to populate the scrollbox
+# add_method -- a reference to a proc to be called when the user adds a new item
+# edit_method -- same as above, for editing and existing item
+# commit_method -- same as above, to commit during the "apply" action
+# title -- top-level title for the dialog
+# width, height -- initial width and height dimensions for the window, also minimum size
+proc ::scrollboxwindow::make {mytoplevel listdata add_method edit_method commit_method title width height } {
+ wm deiconify .pdwindow
+ raise .pdwindow
+ toplevel $mytoplevel -class DialogWindow
+ wm title $mytoplevel $title
+ wm group $mytoplevel .
+ wm transient $mytoplevel .pdwindow
+ wm protocol $mytoplevel WM_DELETE_WINDOW "::scrollboxwindow::cancel $mytoplevel"
+
+ # Enforce a minimum size for the window
+ wm minsize $mytoplevel $width $height
+
+ # Set the current dimensions of the window
+ wm geometry $mytoplevel "${width}x${height}"
+
+ # Add the scrollbox widget
+ ::scrollbox::make $mytoplevel $listdata $add_method $edit_method
+
+ # Use two frames for the buttons, since we want them both
+ # bottom and right
+ frame $mytoplevel.nb
+ pack $mytoplevel.nb -side bottom -fill x -pady 2m
+
+ frame $mytoplevel.nb.buttonframe
+ pack $mytoplevel.nb.buttonframe -side right -padx 2m
+
+ button $mytoplevel.nb.buttonframe.cancel -text [_ "Cancel"]\
+ -command "::scrollboxwindow::cancel $mytoplevel"
+ button $mytoplevel.nb.buttonframe.apply -text [_ "Apply"]\
+ -command "::scrollboxwindow::apply $mytoplevel $commit_method"
+ button $mytoplevel.nb.buttonframe.ok -text [_ "OK"]\
+ -command "::scrollboxwindow::ok $mytoplevel $commit_method"
+
+ pack $mytoplevel.nb.buttonframe.cancel -side left -expand 1 -padx 2m
+ pack $mytoplevel.nb.buttonframe.apply -side left -expand 1 -padx 2m
+ pack $mytoplevel.nb.buttonframe.ok -side left -expand 1 -padx 2m
+}
+
+
diff --git a/pd/tcl/wheredoesthisgo.tcl b/pd/tcl/wheredoesthisgo.tcl
index 3fbb9d1f5..acee40c07 100644
--- a/pd/tcl/wheredoesthisgo.tcl
+++ b/pd/tcl/wheredoesthisgo.tcl
@@ -3,48 +3,87 @@ package provide wheredoesthisgo 0.1
# a place to temporarily store things until they find a home or go away
-set help_top_directory ""
+proc open_file {filename} {
+ set directory [file normalize [file dirname $filename]]
+ set basename [file tail $filename]
+ if {
+ [file exists $filename]
+ && [regexp -nocase -- "\.(pd|pat|mxt)$" $filename]
+ } then {
+ ::pdtk_canvas::started_loading_file [format "%s/%s" $basename $filename]
+ pdsend "pd open [enquote_path $basename] [enquote_path $directory]"
+ # now this is done in pd_guiprefs
+ ::pd_guiprefs::update_recentfiles $filename
+ } {
+ ::pdwindow::post [format [_ "Ignoring '%s': doesn't look like a Pd-file"] $filename]
+ }
+}
+
+# ------------------------------------------------------------------------------
+# procs for panels (openpanel, savepanel)
+proc pdtk_openpanel {target localdir} {
+ if {! [file isdirectory $localdir]} {
+ if { ! [file isdirectory $::fileopendir]} {
+ set ::fileopendir $::env(HOME)
+ }
+ set localdir $::fileopendir
+ }
+ set filename [tk_getOpenFile -initialdir $localdir]
+ if {$filename ne ""} {
+ set ::fileopendir [file dirname $filename]
+ pdsend "$target callback [enquote_path $filename]"
+ }
+}
-proc post_tclinfo {} {
- pdtk_post "Tcl library: [file normalize [info library]]"
- pdtk_post "executable: [file normalize [info nameofexecutable]]"
- pdtk_post "tclversion: [info tclversion]"
- pdtk_post "patchlevel: [info patchlevel]"
- pdtk_post "sharedlibextension: [info sharedlibextension]"
+proc pdtk_savepanel {target localdir} {
+ if {! [file isdirectory $localdir]} {
+ if { ! [file isdirectory $::filenewdir]} {
+ set ::filenewdir $::env(HOME)
+ }
+ set localdir $::filenewdir
+ }
+ set filename [tk_getSaveFile -initialdir $localdir]
+ if {$filename ne ""} {
+ pdsend "$target callback [enquote_path $filename]"
+ }
}
+# ------------------------------------------------------------------------------
+# window info (name, path, parents, children, etc.)
-proc placeholder {args} {
- # PLACEHOLDER
- ::pdwindow::pdtk_post "PLACEHOLDER $args"
+proc lookup_windowname {mytoplevel} {
+ set window [array get ::windowname $mytoplevel]
+ if { $window ne ""} {
+ return [lindex $window 1]
+ } else {
+ return ERROR
+ }
}
+proc tkcanvas_name {mytoplevel} {
+ return "$mytoplevel.c"
+}
-proc open_file {filename} {
- set directory [file dirname $filename]
- set basename [file tail $filename]
- if {[regexp -nocase -- "\.(pd|pat|mxt)$" $filename]} {
- pdsend "pd open [enquote_path $basename] [enquote_path $directory]"
- # remove duplicates first, then the duplicate added after to the top
- set index [lsearch -exact $::recentfiles_list $filename]
- set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
- set ::recentfiles_list \
- "$filename [lrange $::recentfiles_list 0 $::total_recentfiles]"
- ::pd_menus::update_recentfiles_menu
- }
+# ------------------------------------------------------------------------------
+# quoting functions
+
+# enquote a string for find, path, and startup dialog panels, to be decoded by
+# sys_decodedialog()
+proc pdtk_encodedialog {x} {
+ concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
}
-proc lookup_windowname {mytoplevel} {
- foreach window $::menu_windowlist {
- if {[lindex $window 1] eq $mytoplevel} {
- return [lindex $window 0]
+# encode a list with pdtk_encodedialog
+proc pdtk_encode { listdata } {
+ set outlist {}
+ foreach this_path $listdata {
+ if {0==[string match "" $this_path]} {
+ lappend outlist [pdtk_encodedialog $this_path]
}
}
+ return $outlist
}
-
-# ------------------------------------------------------------------------------
-# quoting functions
# TODO enquote a filename to send it to pd, " isn't handled properly tho...
proc enquote_path {message} {
@@ -59,39 +98,14 @@ proc unspace_text {x} {
concat $y
}
-
# ------------------------------------------------------------------------------
-# lost pdtk functions...
-
-# set the checkbox on the "Compute Audio" menuitem and checkbox
-proc pdtk_pd_dsp {value} {
- # TODO canvas_startdsp/stopdsp should really send 1 or 0, not "ON" or "OFF"
- if {$value eq "ON"} {
- set ::dsp 1
- } else {
- set ::dsp 0
- }
-}
-
-proc pdtk_pd_dio {red} {
- # puts stderr [concat pdtk_pd_dio $red]
-}
-
+# watchdog functions
proc pdtk_watchdog {} {
pdsend "pd watchdog"
after 2000 {pdtk_watchdog}
}
-
proc pdtk_ping {} {
pdsend "pd ping"
}
-
-# ------------------------------------------------------------------------------
-# 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
-}
--
GitLab