diff --git a/pd/tcl/AppMain.tcl b/pd/tcl/AppMain.tcl
deleted file mode 100644
index 7c68a9d04c54b6839d388b93d07c7ce441f71d9d..0000000000000000000000000000000000000000
--- a/pd/tcl/AppMain.tcl
+++ /dev/null
@@ -1,17 +0,0 @@
-# This file is for the Wish.app on Mac OS X. It is only used when a Wish.app
-# is loading embedded pd code on Mac OS X. It is completely unused on any
-# 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.
-
-package require apple_events
-
-# 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]
- set argc [expr $argc - 1]
-}
-
-# launch pd-gui.tcl here
-if [catch {source [file join [file dirname [info script]] pd-gui.tcl]}] {
- puts stderr $errorInfo
-}
diff --git a/pd/tcl/Makefile.am b/pd/tcl/Makefile.am
deleted file mode 100644
index 3f7809e09f3343825a899a8c866a6f88aab57a15..0000000000000000000000000000000000000000
--- a/pd/tcl/Makefile.am
+++ /dev/null
@@ -1,16 +0,0 @@
-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
deleted file mode 100644
index 0311add735f4633ef2aa72c5e4374c2b0b4d86d5..0000000000000000000000000000000000000000
--- a/pd/tcl/apple_events.tcl
+++ /dev/null
@@ -1,65 +0,0 @@
-
-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 anti-aliased text
-
-# kAEOpenDocuments
-proc ::tk::mac::OpenDocument {args} {
- 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 {args} {
- ::pdwindow::verbose 1 "::tk::mac::OnHide $args +++++++++++++++++++++"
-}
-
-# kEventAppShown
-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 {args} {
- ::pdwindow::verbose 1 "::tk::mac::ShowPreferences $args ++++++++++++"
- pdsend "pd start-path-dialog"
-}
-
-# kAEQuitApplication
-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} {
- menu_print $::focused_window
-}
-
-proc ::tk::mac::OpenApplication {args} {
- ::pdwindow::verbose 1 "::tk::mac::OpenApplication $args ++++++++++++"
-}
-
-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
deleted file mode 100644
index 0f2696d2dbc2e9aecce8747c85eaf8d5408ea8b0..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_array.tcl
+++ /dev/null
@@ -1,333 +0,0 @@
-package provide dialog_array 0.1
-
-namespace eval ::dialog_array:: {
- namespace export pdtk_array_dialog
- namespace export pdtk_array_listview_new
- namespace export pdtk_array_listview_fillpage
- namespace export pdtk_array_listview_setpage
- namespace export pdtk_array_listview_closeWindow
-}
-
-# global variables for the listview
-array set pd_array_listview_entry {}
-array set pd_array_listview_id {}
-array set pd_array_listview_page {}
-set pd_array_listview_pagesize 0
-# this stores the state of the "save me" check button
-array set saveme_button {}
-# this stores the state of the "draw as" radio buttons
-array set drawas_button {}
-# this stores the state of the "in new graph"/"in last graph" radio buttons
-# and the "delete array" checkbutton
-array set otherflag_button {}
-
-# TODO figure out how to escape $ args so sharptodollar() isn't needed
-
-############ pdtk_array_dialog -- dialog window for arrays #########
-
-proc ::dialog_array::pdtk_array_listview_setpage {arrayName page} {
- set ::pd_array_listview_page($arrayName) $page
-}
-
-proc ::dialog_array::listview_changepage {arrayName np} {
- pdtk_array_listview_setpage \
- $arrayName [expr $::pd_array_listview_page($arrayName) + $np]
- pdtk_array_listview_fillpage $arrayName
-}
-
-proc ::dialog_array::pdtk_array_listview_fillpage {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- set topItem [expr [lindex [$windowName.lb yview] 0] * \
- [$windowName.lb size]]
-
- if {[winfo exists $windowName]} {
- set cmd "$::pd_array_listview_id($arrayName) \
- arrayviewlistfillpage \
- $::pd_array_listview_page($arrayName) \
- $topItem"
-
- pdsend $cmd
- }
-}
-
-proc ::dialog_array::pdtk_array_listview_new {id arrayName page} {
- set ::pd_array_listview_page($arrayName) $page
- set ::pd_array_listview_id($arrayName) $id
- set windowName [format ".%sArrayWindow" $arrayName]
- if [winfo exists $windowName] then [destroy $windowName]
- toplevel $windowName -class DialogWindow
- wm group $windowName .
- wm protocol $windowName WM_DELETE_WINDOW \
- "::dialog_array::listview_close $id $arrayName"
- wm title $windowName [concat $arrayName "(list view)"]
- # FIXME
- set font 12
- set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
- -selectmode extended \
- -relief solid -background white -borderwidth 1 \
- -font [format {{%s} %d %s} $::font_family $font $::font_weight]\
- -yscrollcommand "$windowName.lb.sb set"]
- set $windowName.lb.sb [scrollbar $windowName.lb.sb \
- -command "$windowName.lb yview" -orient vertical]
- place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
- pack $windowName.lb -expand 1 -fill both
- bind $windowName.lb <Double-ButtonPress-1> \
- "::dialog_array::listview_edit $arrayName $page $font"
- # handle copy/paste
- switch -- $::windowingsystem {
- "x11" {selection handle $windowName.lb \
- "::dialog_array::listview_lbselection $arrayName"}
- "win32" {bind $windowName.lb <ButtonPress-3> \
- "::dialog_array::listview_popup $arrayName"}
- }
- set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
- -command "::dialog_array::listview_changepage $arrayName -1"]
- set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
- -command "::dialog_array::listview_changepage $arrayName 1"]
- pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
- pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
- focus $windowName
-}
-
-proc ::dialog_array::listview_lbselection {arrayName off size} {
- set windowName [format ".%sArrayWindow" $arrayName]
- set itemNums [$windowName.lb curselection]
- set cbString ""
- for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- append cbString "\n"
- }
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- set last $cbString
-}
-
-# Win32 uses a popup menu for copy/paste
-proc ::dialog_array::listview_popup {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- if [winfo exists $windowName.popup] then [destroy $windowName.popup]
- menu $windowName.popup -tearoff false
- $windowName.popup add command -label [_ "Copy"] \
- -command "::dialog_array::listview_copy $arrayName; \
- destroy $windowName.popup"
- $windowName.popup add command -label [_ "Paste"] \
- -command "::dialog_array::listview_paste $arrayName; \
- destroy $windowName.popup"
- tk_popup $windowName.popup [winfo pointerx $windowName] \
- [winfo pointery $windowName] 0
-}
-
-proc ::dialog_array::listview_copy {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- set itemNums [$windowName.lb curselection]
- set cbString ""
- for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- append cbString "\n"
- }
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- clipboard clear
- clipboard append $cbString
-}
-
-proc ::dialog_array::listview_paste {arrayName} {
- set cbString [selection get -selection CLIPBOARD]
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- set itemNum [lindex [$lbName curselection] 0]
- set splitChars ", \n"
- set itemString [split $cbString $splitChars]
- set flag 1
- for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
- if {[lindex $itemString $i] ne {}} {
- pdsend "$arrayName [expr $itemNum + \
- [expr $counter + \
- [expr $::pd_array_listview_pagesize \
- * $::pd_array_listview_page($arrayName)]]] \
- [lindex $itemString $i]"
- incr counter
- set flag 0
- }
- }
-}
-
-proc ::dialog_array::listview_edit {arrayName page font} {
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- if {[winfo exists $lbName.entry]} {
- ::dialog_array::listview_update_entry \
- $arrayName $::pd_array_listview_entry($arrayName)
- unset ::pd_array_listview_entry($arrayName)
- }
- set itemNum [$lbName index active]
- set ::pd_array_listview_entry($arrayName) $itemNum
- set bbox [$lbName bbox $itemNum]
- set y [expr [lindex $bbox 1] - 4]
- set $lbName.entry [entry $lbName.entry \
- -font [format {{%s} %d %s} $::font_family $font $::font_weight]]
- $lbName.entry insert 0 []
- place configure $lbName.entry -relx 0 -y $y -relwidth 1
- lower $lbName.entry
- focus $lbName.entry
- bind $lbName.entry <Return> \
- "::dialog_array::listview_update_entry $arrayName $itemNum;"
-}
-
-proc ::dialog_array::listview_update_entry {arrayName itemNum} {
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- set splitChars ", \n"
- set itemString [split [$lbName.entry get] $splitChars]
- set flag 1
- for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
- if {[lindex $itemString $i] ne {}} {
- pdsend "$arrayName [expr $itemNum + \
- [expr $counter + \
- [expr $::pd_array_listview_pagesize \
- * $::pd_array_listview_page($arrayName)]]] \
- [lindex $itemString $i]"
- incr counter
- set flag 0
- }
- }
- pdtk_array_listview_fillpage $arrayName
- destroy $lbName.entry
-}
-
-proc ::dialog_array::pdtk_array_listview_closeWindow {arrayName} {
- set mytoplevel [format ".%sArrayWindow" $arrayName]
- destroy $mytoplevel
-}
-
-proc ::dialog_array::listview_close {mytoplevel arrayName} {
- pdtk_array_listview_closeWindow $arrayName
- pdsend "$mytoplevel arrayviewclose"
-}
-
-proc ::dialog_array::apply {mytoplevel} {
-# TODO figure out how to ditch this escaping mechanism
- set mofo [$mytoplevel.name.entry get]
- if {[string index $mofo 0] == "$"} {
- set mofo [string replace $mofo 0 0 #] }
-
- pdsend "$mytoplevel arraydialog \
- $mofo \
- [$mytoplevel.size.entry get] \
- [expr $::saveme_button($mytoplevel) + (2 * $::drawas_button($mytoplevel))] \
- $::otherflag_button($mytoplevel)"
-}
-
-proc ::dialog_array::openlistview {mytoplevel} {
- pdsend "$mytoplevel arrayviewlistnew"
-}
-
-proc ::dialog_array::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_array::ok {mytoplevel} {
- ::dialog_array::apply $mytoplevel
- ::dialog_array::cancel $mytoplevel
-}
-
-proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} {
- if {[winfo exists $mytoplevel]} {
- wm deiconify $mytoplevel
- raise $mytoplevel
- } else {
- create_dialog $mytoplevel $newone
- }
-
- $mytoplevel.name.entry insert 0 $name
- $mytoplevel.size.entry insert 0 $size
- set ::saveme_button($mytoplevel) [expr $flags & 1]
- set ::drawas_button($mytoplevel) [expr ( $flags & 6 ) >> 1]
- set ::otherflag_button($mytoplevel) 0
-# pd -> tcl
-# 2 * (int)(template_getfloat(template_findbyname(sc->sc_template), gensym("style"), x->x_scalar->sc_vec, 1)));
-
-# tcl->pd
-# int style = ((flags & 6) >> 1);
-}
-
-proc ::dialog_array::create_dialog {mytoplevel newone} {
- toplevel $mytoplevel -class DialogWindow
- wm title $mytoplevel [_ "Array Properties"]
- 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
- pack $mytoplevel.name -side top
- label $mytoplevel.name.label -text [_ "Name:"]
- entry $mytoplevel.name.entry
- pack $mytoplevel.name.label $mytoplevel.name.entry -anchor w
-
- frame $mytoplevel.size
- pack $mytoplevel.size -side top
- label $mytoplevel.size.label -text [_ "Size:"]
- entry $mytoplevel.size.entry
- pack $mytoplevel.size.label $mytoplevel.size.entry -anchor w
-
- checkbutton $mytoplevel.saveme -text [_ "Save contents"] \
- -variable ::saveme_button($mytoplevel) -anchor w
- pack $mytoplevel.saveme -side top
-
- labelframe $mytoplevel.drawas -text [_ "Draw as:"] -padx 20 -borderwidth 1
- pack $mytoplevel.drawas -side top -fill x
- radiobutton $mytoplevel.drawas.points -value 0 \
- -variable ::drawas_button($mytoplevel) -text [_ "Points"]
- radiobutton $mytoplevel.drawas.polygon -value 1 \
- -variable ::drawas_button($mytoplevel) -text [_ "Polygon"]
- radiobutton $mytoplevel.drawas.bezier -value 2 \
- -variable ::drawas_button($mytoplevel) -text [_ "Bezier curve"]
- pack $mytoplevel.drawas.points -side top -anchor w
- pack $mytoplevel.drawas.polygon -side top -anchor w
- pack $mytoplevel.drawas.bezier -side top -anchor w
-
- if {$newone != 0} {
- labelframe $mytoplevel.radio -text [_ "Put array into:"] -padx 20 -borderwidth 1
- pack $mytoplevel.radio -side top -fill x
- radiobutton $mytoplevel.radio.radio0 -value 0 \
- -variable ::otherflag_button($mytoplevel) -text [_ "New graph"]
- radiobutton $mytoplevel.radio.radio1 -value 1 \
- -variable ::otherflag_button($mytoplevel) -text [_ "Last graph"]
- pack $mytoplevel.radio.radio0 -side top -anchor w
- pack $mytoplevel.radio.radio1 -side top -anchor w
- } else {
- checkbutton $mytoplevel.deletearray -text [_ "Delete array"] \
- -variable ::otherflag_button($mytoplevel) -anchor w
- pack $mytoplevel.deletearray -side top
- }
- # jsarlo
- if {$newone == 0} {
- button $mytoplevel.listview -text [_ "Open List View..."] \
- -command "::dialog_array::openlistview $mytoplevel [$mytoplevel.name.entry get]"
- pack $mytoplevel.listview -side top
- }
- # end jsarlo
- frame $mytoplevel.buttonframe
- pack $mytoplevel.buttonframe -side bottom -expand 1 -fill x -pady 2m
- button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
- -command "::dialog_array::cancel $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.ok -side left -expand 1 -fill x -padx 10
-}
diff --git a/pd/tcl/dialog_audio.tcl b/pd/tcl/dialog_audio.tcl
deleted file mode 100644
index 56f18f4559f771ecbc0cb5bcb0ed2bd086efbeb4..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_audio.tcl
+++ /dev/null
@@ -1,323 +0,0 @@
-package provide dialog_audio 0.1
-
-namespace eval ::dialog_audio:: {
- namespace export pdtk_audio_dialog
-}
-
-# 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 {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 audio_blocksize
-
- pdsend "pd audio-dialog \
- $audio_indev1 \
- $audio_indev2 \
- $audio_indev3 \
- $audio_indev4 \
- [expr $audio_inchan1 * ( $audio_inenable1 ? 1 : -1 ) ]\
- [expr $audio_inchan2 * ( $audio_inenable2 ? 1 : -1 ) ]\
- [expr $audio_inchan3 * ( $audio_inenable3 ? 1 : -1 ) ]\
- [expr $audio_inchan4 * ( $audio_inenable4 ? 1 : -1 ) ]\
- $audio_outdev1 \
- $audio_outdev2 \
- $audio_outdev3 \
- $audio_outdev4 \
- [expr $audio_outchan1 * ( $audio_outenable1 ? 1 : -1 ) ]\
- [expr $audio_outchan2 * ( $audio_outenable2 ? 1 : -1 ) ]\
- [expr $audio_outchan3 * ( $audio_outenable3 ? 1 : -1 ) ]\
- [expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
- $audio_sr \
- $audio_advance \
- $audio_callback \
- $audio_blocksize"
-}
-
-proc ::dialog_audio::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_audio::ok {mytoplevel} {
- ::dialog_audio::apply $mytoplevel
- ::dialog_audio::cancel $mytoplevel
-}
-
-# callback from popup menu
-proc audio_popup_action {buttonname varname devlist index} {
- global audio_indevlist audio_outdevlist $varname
- $buttonname configure -text [lindex $devlist $index]
- set $varname $index
-}
-
-# create a popup menu
-proc audio_popup {name buttonname varname devlist} {
- if [winfo exists $name.popup] {destroy $name.popup}
- menu $name.popup -tearoff false
- if {$::windowingsystem eq "win32"} {
- $name.popup configure -font menuFont
- }
- for {set x 0} {$x<[llength $devlist]} {incr x} {
- $name.popup add command -label [lindex $devlist $x] \
- -command [list audio_popup_action \
- $buttonname $varname $devlist $x]
- }
- tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
-}
-
-# start a dialog window to select audio devices and settings. "multi"
-# is 0 if only one device is allowed; 1 if one apiece may be specified for
-# input and output; and 2 if we can select multiple devices. "longform"
-# (which only makes sense if "multi" is 2) asks us to make controls for
-# opening several devices; if not, we get an extra button to turn longform
-# on and restart the dialog.
-
-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 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 audio_blocksize
- global audio_indevlist audio_outdevlist
- global pd_indev pd_outdev
- global audio_longform
-
- set audio_indev1 $indev1
- set audio_indev2 $indev2
- set audio_indev3 $indev3
- set audio_indev4 $indev4
-
- set audio_inchan1 [expr ( $inchan1 > 0 ? $inchan1 : -$inchan1 ) ]
- set audio_inenable1 [expr $inchan1 > 0 ]
- set audio_inchan2 [expr ( $inchan2 > 0 ? $inchan2 : -$inchan2 ) ]
- set audio_inenable2 [expr $inchan2 > 0 ]
- set audio_inchan3 [expr ( $inchan3 > 0 ? $inchan3 : -$inchan3 ) ]
- set audio_inenable3 [expr $inchan3 > 0 ]
- set audio_inchan4 [expr ( $inchan4 > 0 ? $inchan4 : -$inchan4 ) ]
- set audio_inenable4 [expr $inchan4 > 0 ]
-
- set audio_outdev1 $outdev1
- set audio_outdev2 $outdev2
- set audio_outdev3 $outdev3
- set audio_outdev4 $outdev4
-
- set audio_outchan1 [expr ( $outchan1 > 0 ? $outchan1 : -$outchan1 ) ]
- set audio_outenable1 [expr $outchan1 > 0 ]
- set audio_outchan2 [expr ( $outchan2 > 0 ? $outchan2 : -$outchan2 ) ]
- set audio_outenable2 [expr $outchan2 > 0 ]
- set audio_outchan3 [expr ( $outchan3 > 0 ? $outchan3 : -$outchan3 ) ]
- set audio_outenable3 [expr $outchan3 > 0 ]
- set audio_outchan4 [expr ( $outchan4 > 0 ? $outchan4 : -$outchan4 ) ]
- set audio_outenable4 [expr $outchan4 > 0 ]
-
- set audio_sr $sr
- set audio_advance $advance
- set audio_callback $callback
- 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 $mytoplevel.srf
- pack $mytoplevel.srf -side top
-
- 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 $mytoplevel.srf.x4 -variable audio_callback \
- -text [_ "Use callbacks"] -anchor e
- pack $mytoplevel.srf.x4 -side left
- }
- # input device 1
- frame $mytoplevel.in1f
- pack $mytoplevel.in1f -side top
-
- checkbutton $mytoplevel.in1f.x0 -variable audio_inenable1 \
- -text [_ "Input device 1:"] -anchor e
- 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 $mytoplevel.in2f
- pack $mytoplevel.in2f -side top
-
- checkbutton $mytoplevel.in2f.x0 -variable audio_inenable2 \
- -text [_ "Input device 2:"] -anchor e
- button $mytoplevel.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
- -command [list audio_popup $mytoplevel $mytoplevel.in2f.x1 audio_indev2 \
- $audio_indevlist]
- 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 $mytoplevel.in3f
- pack $mytoplevel.in3f -side top
-
- checkbutton $mytoplevel.in3f.x0 -variable audio_inenable3 \
- -text [_ "Input device 3:"] -anchor e
- button $mytoplevel.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
- -command [list audio_popup $mytoplevel $mytoplevel.in3f.x1 audio_indev3 \
- $audio_indevlist]
- 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 $mytoplevel.in4f
- pack $mytoplevel.in4f -side top
-
- checkbutton $mytoplevel.in4f.x0 -variable audio_inenable4 \
- -text [_ "Input device 4:"] -anchor e
- button $mytoplevel.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
- -command [list audio_popup $mytoplevel $mytoplevel.in4f.x1 audio_indev4 \
- $audio_indevlist]
- 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 $mytoplevel.out1f
- pack $mytoplevel.out1f -side top
-
- checkbutton $mytoplevel.out1f.x0 -variable audio_outenable1 \
- -text [_ "Output device 1:"] -anchor e
- if {$multi == 0} {
- label $mytoplevel.out1f.l1 \
- -text [_ "(same as input device) .............. "]
- } else {
- button $mytoplevel.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
- -command [list audio_popup $mytoplevel $mytoplevel.out1f.x1 audio_outdev1 \
- $audio_outdevlist]
- }
- label $mytoplevel.out1f.l2 -text [_ "Channels:"]
- entry $mytoplevel.out1f.x2 -textvariable audio_outchan1 -width 3
- if {$multi == 0} {
- pack $mytoplevel.out1f.x0 $mytoplevel.out1f.l1 $mytoplevel.out1f.x2 -side left -fill x
- } else {
- 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 $mytoplevel.out2f
- pack $mytoplevel.out2f -side top
-
- checkbutton $mytoplevel.out2f.x0 -variable audio_outenable2 \
- -text [_ "Output device 2:"] -anchor e
- button $mytoplevel.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
- -command \
- [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 $mytoplevel.out3f
- pack $mytoplevel.out3f -side top
-
- checkbutton $mytoplevel.out3f.x0 -variable audio_outenable3 \
- -text [_ "Output device 3:"] -anchor e
- button $mytoplevel.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
- -command \
- [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 $mytoplevel.out4f
- pack $mytoplevel.out4f -side top
-
- checkbutton $mytoplevel.out4f.x0 -variable audio_outenable4 \
- -text [_ "Output device 4:"] -anchor e
- button $mytoplevel.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
- -command \
- [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 $mytoplevel.longbutton
- pack $mytoplevel.longbutton -side top
- button $mytoplevel.longbutton.b -text [_ "Use multiple devices"] \
- -command {pdsend "pd audio-properties 1"}
- pack $mytoplevel.longbutton.b
- }
- $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
deleted file mode 100644
index ea3f5d65ac3ced2bba062e2ac8598307b3aa8e0e..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_canvas.tcl
+++ /dev/null
@@ -1,219 +0,0 @@
-
-# TODO offset this panel so it doesn't overlap the pdtk_array panel
-
-package provide dialog_canvas 0.1
-
-namespace eval ::dialog_canvas:: {
- namespace export pdtk_canvas_dialog
-}
-
-# global variables to store checkbox state on canvas properties window. These
-# are only used in the context of getting data from the checkboxes, so they
-# aren't really useful elsewhere. It would be nice to have them globally
-# useful, but that would mean changing the C code.
-array set graphme_button {}
-array set hidetext_button {}
-
-############# pdtk_canvas_dialog -- dialog window for canvases #################
-
-proc ::dialog_canvas::apply {mytoplevel} {
- pdsend "$mytoplevel donecanvasdialog \
- [$mytoplevel.scale.x.entry get] \
- [$mytoplevel.scale.y.entry get] \
- [expr $::graphme_button($mytoplevel) + 2 * $::hidetext_button($mytoplevel)] \
- [$mytoplevel.range.x.from_entry get] \
- [$mytoplevel.range.y.from_entry get] \
- [$mytoplevel.range.x.to_entry get] \
- [$mytoplevel.range.y.to_entry get] \
- [$mytoplevel.range.x.size_entry get] \
- [$mytoplevel.range.y.size_entry get] \
- [$mytoplevel.range.x.margin_entry get] \
- [$mytoplevel.range.y.margin_entry get]"
-}
-
-proc ::dialog_canvas::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_canvas::ok {mytoplevel} {
- ::dialog_canvas::apply $mytoplevel
- ::dialog_canvas::cancel $mytoplevel
-}
-
-proc ::dialog_canvas::checkcommand {mytoplevel} {
- if { $::graphme_button($mytoplevel) != 0 } {
- $mytoplevel.scale.x.entry configure -state disabled
- $mytoplevel.scale.y.entry configure -state disabled
- $mytoplevel.parent.hidetext configure -state normal
- $mytoplevel.range.x.from_entry configure -state normal
- $mytoplevel.range.x.to_entry configure -state normal
- $mytoplevel.range.x.size_entry configure -state normal
- $mytoplevel.range.x.margin_entry configure -state normal
- $mytoplevel.range.y.from_entry configure -state normal
- $mytoplevel.range.y.to_entry configure -state normal
- $mytoplevel.range.y.size_entry configure -state normal
- $mytoplevel.range.y.margin_entry configure -state normal
- if { [$mytoplevel.range.x.from_entry get] == 0 \
- && [$mytoplevel.range.y.from_entry get] == 0 \
- && [$mytoplevel.range.x.to_entry get] == 0 \
- && [$mytoplevel.range.y.to_entry get] == 0 } {
- $mytoplevel.range.y.to_entry insert 0 1
- $mytoplevel.range.y.to_entry insert 0 1
- }
- if { [$mytoplevel.range.x.size_entry get] == 0 } {
- $mytoplevel.range.x.size_entry delete 0 end
- $mytoplevel.range.x.margin_entry delete 0 end
- $mytoplevel.range.x.size_entry insert 0 85
- $mytoplevel.range.x.margin_entry insert 0 100
- }
- if { [$mytoplevel.range.y.size_entry get] == 0 } {
- $mytoplevel.range.y.size_entry delete 0 end
- $mytoplevel.range.y.margin_entry delete 0 end
- $mytoplevel.range.y.size_entry insert 0 60
- $mytoplevel.range.y.margin_entry insert 0 100
- }
- } else {
- $mytoplevel.scale.x.entry configure -state normal
- $mytoplevel.scale.y.entry configure -state normal
- $mytoplevel.parent.hidetext configure -state disabled
- $mytoplevel.range.x.from_entry configure -state disabled
- $mytoplevel.range.x.to_entry configure -state disabled
- $mytoplevel.range.x.size_entry configure -state disabled
- $mytoplevel.range.x.margin_entry configure -state disabled
- $mytoplevel.range.y.from_entry configure -state disabled
- $mytoplevel.range.y.to_entry configure -state disabled
- $mytoplevel.range.y.size_entry configure -state disabled
- $mytoplevel.range.y.margin_entry configure -state disabled
- if { [$mytoplevel.scale.x.entry get] == 0 } {
- $mytoplevel.scale.x.entry delete 0 end
- $mytoplevel.scale.x.entry insert 0 1
- }
- if { [$mytoplevel.scale.y.entry get] == 0 } {
- $mytoplevel.scale.y.entry delete 0 end
- $mytoplevel.scale.y.entry insert 0 1
- }
- }
-}
-
-proc ::dialog_canvas::pdtk_canvas_dialog {mytoplevel xscale yscale graphmeflags \
- xfrom yfrom xto yto \
- xsize ysize xmargin ymargin} {
- if {[winfo exists $mytoplevel]} {
- wm deiconify $mytoplevel
- raise $mytoplevel
- } else {
- create_dialog $mytoplevel
- }
- switch -- $graphmeflags {
- 0 {
- $mytoplevel.parent.graphme deselect
- $mytoplevel.parent.hidetext deselect
- } 1 {
- $mytoplevel.parent.graphme select
- $mytoplevel.parent.hidetext deselect
- } 2 {
- $mytoplevel.parent.graphme deselect
- $mytoplevel.parent.hidetext select
- } 3 {
- $mytoplevel.parent.graphme select
- $mytoplevel.parent.hidetext select
- } default {
- ::pdwindow::error [_ "WARNING: unknown graphme flags received in pdtk_canvas_dialog"]
- }
- }
-
- $mytoplevel.scale.x.entry insert 0 $xscale
- $mytoplevel.scale.y.entry insert 0 $yscale
- $mytoplevel.range.x.from_entry insert 0 $xfrom
- $mytoplevel.range.y.from_entry insert 0 $yfrom
- $mytoplevel.range.x.to_entry insert 0 $xto
- $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 $xmargin
- $mytoplevel.range.y.margin_entry insert 0 $ymargin
-
- ::dialog_canvas::checkcommand $mytoplevel
-}
-
-proc ::dialog_canvas::create_dialog {mytoplevel} {
- toplevel $mytoplevel -class DialogWindow
- wm title $mytoplevel [_ "Canvas Properties"]
- 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
- pack $mytoplevel.scale -side top -fill x
- frame $mytoplevel.scale.x -pady 2 -borderwidth 1
- pack $mytoplevel.scale.x -side top
- label $mytoplevel.scale.x.label -text [_ "X units per pixel:"]
- entry $mytoplevel.scale.x.entry -width 10
- pack $mytoplevel.scale.x.label $mytoplevel.scale.x.entry -side left
- frame $mytoplevel.scale.y -pady 2
- pack $mytoplevel.scale.y -side top
- label $mytoplevel.scale.y.label -text [_ "Y units per pixel:"]
- entry $mytoplevel.scale.y.entry -width 10
- pack $mytoplevel.scale.y.label $mytoplevel.scale.y.entry -side left
-
- labelframe $mytoplevel.parent -text [_ "Appearance on parent patch"] -borderwidth 1
- pack $mytoplevel.parent -side top -fill x
- checkbutton $mytoplevel.parent.graphme -text [_ "Graph-On-Parent"] \
- -anchor w -variable graphme_button($mytoplevel) \
- -command [concat ::dialog_canvas::checkcommand $mytoplevel]
- pack $mytoplevel.parent.graphme -side top -fill x -padx 40
- checkbutton $mytoplevel.parent.hidetext -text [_ "Hide object name and arguments"] \
- -anchor w -variable hidetext_button($mytoplevel) \
- -command [concat ::dialog_canvas::checkcommand $mytoplevel]
- pack $mytoplevel.parent.hidetext -side top -fill x -padx 40
-
- labelframe $mytoplevel.range -text [_ "Range and size"] -borderwidth 1
- pack $mytoplevel.range -side top -fill x
- frame $mytoplevel.range.x -padx 2 -pady 2
- pack $mytoplevel.range.x -side top
- label $mytoplevel.range.x.from_label -text [_ "X range, from"]
- entry $mytoplevel.range.x.from_entry -width 6
- label $mytoplevel.range.x.to_label -text [_ "to"]
- entry $mytoplevel.range.x.to_entry -width 6
- label $mytoplevel.range.x.size_label -text [_ "Size:"]
- entry $mytoplevel.range.x.size_entry -width 4
- label $mytoplevel.range.x.margin_label -text [_ "Margin:"]
- entry $mytoplevel.range.x.margin_entry -width 4
- pack $mytoplevel.range.x.from_label $mytoplevel.range.x.from_entry \
- $mytoplevel.range.x.to_label $mytoplevel.range.x.to_entry \
- $mytoplevel.range.x.size_label $mytoplevel.range.x.size_entry \
- $mytoplevel.range.x.margin_label $mytoplevel.range.x.margin_entry \
- -side left
- frame $mytoplevel.range.y -padx 2 -pady 2
- pack $mytoplevel.range.y -side top
- label $mytoplevel.range.y.from_label -text [_ "Y range, from"]
- entry $mytoplevel.range.y.from_entry -width 6
- label $mytoplevel.range.y.to_label -text [_ "to"]
- entry $mytoplevel.range.y.to_entry -width 6
- label $mytoplevel.range.y.size_label -text [_ "Size:"]
- entry $mytoplevel.range.y.size_entry -width 4
- label $mytoplevel.range.y.margin_label -text [_ "Margin:"]
- entry $mytoplevel.range.y.margin_entry -width 4
- pack $mytoplevel.range.y.from_label $mytoplevel.range.y.from_entry \
- $mytoplevel.range.y.to_label $mytoplevel.range.y.to_entry \
- $mytoplevel.range.y.size_label $mytoplevel.range.y.size_entry \
- $mytoplevel.range.y.margin_label $mytoplevel.range.y.margin_entry \
- -side left
-
- frame $mytoplevel.buttons
- pack $mytoplevel.buttons -side bottom -fill x -expand 1 -pady 2m
- button $mytoplevel.buttons.cancel -text [_ "Cancel"] \
- -command "::dialog_canvas::cancel $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.ok -side left -expand 1 -fill x -padx 10
- }
diff --git a/pd/tcl/dialog_data.tcl b/pd/tcl/dialog_data.tcl
deleted file mode 100644
index 0bc989f5344fba8381cc3da2aaac5b03585571c7..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_data.tcl
+++ /dev/null
@@ -1,53 +0,0 @@
-
-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
deleted file mode 100644
index 443bec3a89d2b14f112c09e6aa19725e17e738c2..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_find.tcl
+++ /dev/null
@@ -1,182 +0,0 @@
-# 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 pdtk_couldnotfind
-}
-
-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
- variable find_history
-
- set findstring [.find.entry get]
- 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
- 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
- }
- } else {
- if {$findstring eq $previous_findstring \
- && $wholeword_button == $previous_wholeword_button} {
- pdsend "$find_in_window findagain"
- } else {
- 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_window_to_search {mytoplevel} {
- variable find_in_window $mytoplevel
- if {[winfo exists .find.frame.targetlabel]} {
- if {$find_in_window eq ".find"} {
- set find_in_window [winfo toplevel [lindex [wm stackorder .] end-1]]
- }
- # 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::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
- 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 -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 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.close -side right -padx 6 -pady 3
- }
- # 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
deleted file mode 100644
index fce1600039e130c19d77283db4c5c7920f93c689..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_font.tcl
+++ /dev/null
@@ -1,136 +0,0 @@
-
-package provide dialog_font 0.1
-
-namespace eval ::dialog_font:: {
- variable fontsize 10
- variable stretchval 100
- variable whichstretch 1
- variable canvaswindow
- variable sizes {8 10 12 16 24 36}
-
- 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 PatchWindow
-# has focus
-
-proc ::dialog_font::apply {mytoplevel myfontsize} {
- if {$mytoplevel eq ".pdwindow"} {
- .pdwindow.text configure -font "-size $myfontsize"
- } else {
- variable stretchval
- variable whichstretch
- pdsend "$mytoplevel font $myfontsize $stretchval $whichstretch"
- }
-}
-
-proc ::dialog_font::cancel {gfxstub} {
- if {$gfxstub ne ".pdwindow"} {
- pdsend "$gfxstub cancel"
- }
- destroy .font
-}
-
-proc ::dialog_font::ok {gfxstub} {
- variable fontsize
- apply $gfxstub $fontsize
- cancel $gfxstub
-}
-
-proc ::dialog_font::update_font_dialog {mytoplevel} {
- variable canvaswindow $mytoplevel
- if {[winfo exists .font]} {
- wm title .font [format [_ "%s Font"] [lookup_windowname $mytoplevel]]
- }
-}
-
-proc ::dialog_font::arrow_fontchange {change} {
- variable sizes
- 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 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 {gfxstub initsize} {
- variable fontsize $initsize
- variable whichstretch 1
- variable stretchval 100
- if {[winfo exists .font]} {
- wm deiconify .font
- raise .font
- # 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 "$gfxstub cancel"
- } else {
- create_dialog $gfxstub
- }
-}
-
-proc ::dialog_font::create_dialog {gfxstub} {
- toplevel .font -class DialogWindow
- .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 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 $gfxstub"
- pack .font.buttonframe.ok -side left -expand 1
-
- labelframe .font.fontsize -text [_ "Font Size"] -padx 5 -pady 4 -borderwidth 1 \
- -width [::msgcat::mcmax "Font Size"] -labelanchor n
- pack .font.fontsize -side left -padx 5
-
- # this is whacky Tcl at its finest, but I couldn't resist...
- foreach size $::dialog_font::sizes {
- radiobutton .font.fontsize.radio$size -value $size -text $size \
- -variable ::dialog_font::fontsize \
- -command [format {::dialog_font::apply $::dialog_font::canvaswindow %s} $size]
- pack .font.fontsize.radio$size -side top -anchor w
- }
-
- labelframe .font.stretch -text [_ "Stretch"] -padx 5 -pady 5 -borderwidth 1 \
- -width [::msgcat::mcmax "Stretch"] -labelanchor n
- pack .font.stretch -side left -padx 5 -fill y
-
- entry .font.stretch.entry -textvariable ::dialog_font::stretchval -width 5
- pack .font.stretch.entry -side top -pady 5
-
- radiobutton .font.stretch.radio1 -text [_ "X and Y"] \
- -value 1 -variable ::dialog_font::whichstretch
- radiobutton .font.stretch.radio2 -text [_ "X only"] \
- -value 2 -variable ::dialog_font::whichstretch
- radiobutton .font.stretch.radio3 -text [_ "Y only"] \
- -value 3 -variable ::dialog_font::whichstretch
-
- pack .font.stretch.radio1 -side top -anchor w
- pack .font.stretch.radio2 -side top -anchor w
- pack .font.stretch.radio3 -side top -anchor w
-}
diff --git a/pd/tcl/dialog_gatom.tcl b/pd/tcl/dialog_gatom.tcl
deleted file mode 100644
index 3b30a1a9ef5e00ff921d29f8ea22393a0712d993..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_gatom.tcl
+++ /dev/null
@@ -1,175 +0,0 @@
-
-package provide dialog_gatom 0.1
-
-package require wheredoesthisgo
-
-namespace eval ::dialog_gatom:: {
- namespace export pdtk_gatom_dialog
-}
-
-# array for communicating the position of the radiobuttons (Tk's
-# radiobutton widget requires this to be global)
-array set gatomlabel_radio {}
-
-############ pdtk_gatom_dialog -- run a gatom dialog #########
-
-proc ::dialog_gatom::escape {sym} {
- if {[string length $sym] == 0} {
- set ret "-"
- } else {
- if {[string equal -length 1 $sym "-"]} {
- set ret [string replace $sym 0 0 "--"]
- } else {
- set ret [string map {"$" "#"} $sym]
- }
- }
- return [unspace_text $ret]
-}
-
-proc ::dialog_gatom::unescape {sym} {
- if {[string equal -length 1 $sym "-"]} {
- set ret [string replace $sym 0 0 ""]
- } else {
- set ret [string map {"#" "$"} $sym]
- }
- return $ret
-}
-
-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.receive.entry get]] \
- [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]]"
-}
-
-proc ::dialog_gatom::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_gatom::ok {mytoplevel} {
- ::dialog_gatom::apply $mytoplevel
- ::dialog_gatom::cancel $mytoplevel
-}
-
-# set up the panel with the info from pd
-proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower initupper \
- initgatomlabel_radio \
- initgatomlabel initreceive initsend} {
- global gatomlabel_radio
- set gatomlabel_radio($mytoplevel) $initgatomlabel_radio
-
- if {[winfo exists $mytoplevel]} {
- wm deiconify $mytoplevel
- raise $mytoplevel
- } else {
- create_dialog $mytoplevel
- }
-
- $mytoplevel.width.entry insert 0 $initwidth
- $mytoplevel.limits.lower.entry insert 0 $initlower
- $mytoplevel.limits.upper.entry insert 0 $initupper
- if {$initgatomlabel ne "-"} {
- $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 \
- [::dialog_gatom::unescape $initsend]
- }
- if {$initreceive ne "-"} {
- $mytoplevel.s_r.receive.entry insert 0 \
- [::dialog_gatom::unescape $initreceive]
- }
-}
-
-proc ::dialog_gatom::create_dialog {mytoplevel} {
- global gatomlabel_radio
-
- toplevel $mytoplevel -class DialogWindow
- wm title $mytoplevel [_ "Atom Box Properties"]
- 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
- pack $mytoplevel.width -side top
- label $mytoplevel.width.label -text [_ "Width:"]
- entry $mytoplevel.width.entry -width 4
- pack $mytoplevel.width.label $mytoplevel.width.entry -side left
-
- labelframe $mytoplevel.limits -text [_ "Limits"] -padx 15 -pady 4 -borderwidth 1
- pack $mytoplevel.limits -side top -fill x
- frame $mytoplevel.limits.lower
- pack $mytoplevel.limits.lower -side left
- label $mytoplevel.limits.lower.label -text [_ "Lower:"]
- entry $mytoplevel.limits.lower.entry -width 7
- pack $mytoplevel.limits.lower.label $mytoplevel.limits.lower.entry -side left
- frame $mytoplevel.limits.upper
- pack $mytoplevel.limits.upper -side left
- label $mytoplevel.limits.upper.label -text [_ "Upper:"]
- entry $mytoplevel.limits.upper.entry -width 7
- pack $mytoplevel.limits.upper.label $mytoplevel.limits.upper.entry -side left
-
- labelframe $mytoplevel.gatomlabel -text [_ "Label"] -padx 5 -pady 5 -borderwidth 1
- pack $mytoplevel.gatomlabel -side top -fill x -pady 5
- frame $mytoplevel.gatomlabel.name
- pack $mytoplevel.gatomlabel.name -side top
- entry $mytoplevel.gatomlabel.name.entry -width 33
- pack $mytoplevel.gatomlabel.name.entry -side left
- frame $mytoplevel.gatomlabel.radio
- pack $mytoplevel.gatomlabel.radio -side top
- radiobutton $mytoplevel.gatomlabel.radio.left -value 0 -text [_ "Left "] \
- -variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
- radiobutton $mytoplevel.gatomlabel.radio.right -value 1 -text [_ "Right"] \
- -variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
- radiobutton $mytoplevel.gatomlabel.radio.top -value 2 -text [_ "Top"] \
- -variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
- radiobutton $mytoplevel.gatomlabel.radio.bottom -value 3 -text [_ "Bottom"] \
- -variable gatomlabel_radio($mytoplevel) -justify left -takefocus 0
- pack $mytoplevel.gatomlabel.radio.left -side left -anchor w
- pack $mytoplevel.gatomlabel.radio.right -side right -anchor w
- pack $mytoplevel.gatomlabel.radio.top -side top -anchor w
- pack $mytoplevel.gatomlabel.radio.bottom -side bottom -anchor w
-
- labelframe $mytoplevel.s_r -text [_ "Messages"] -padx 5 -pady 5 -borderwidth 1
- pack $mytoplevel.s_r -side top -fill x
- frame $mytoplevel.s_r.send
- pack $mytoplevel.s_r.send -side top -anchor e
- label $mytoplevel.s_r.send.label -text [_ "Send symbol:"]
- entry $mytoplevel.s_r.send.entry -width 21
- pack $mytoplevel.s_r.send.entry $mytoplevel.s_r.send.label -side right
-
- frame $mytoplevel.s_r.receive
- pack $mytoplevel.s_r.receive -side top -anchor e
- label $mytoplevel.s_r.receive.label -text [_ "Receive symbol:"]
- entry $mytoplevel.s_r.receive.entry -width 21
- 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 -expand 1 -pady 2m
- button $mytoplevel.buttonframe.cancel -text [_ "Cancel"] \
- -command "::dialog_gatom::cancel $mytoplevel"
- 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 -fill x -padx 10
-
- $mytoplevel.width.entry select from 0
- $mytoplevel.width.entry select adjust end
- focus $mytoplevel.width.entry
-}
diff --git a/pd/tcl/dialog_iemgui.tcl b/pd/tcl/dialog_iemgui.tcl
deleted file mode 100644
index 5ad6cad584f880acdb2319933797566ebaa702a6..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_iemgui.tcl
+++ /dev/null
@@ -1,767 +0,0 @@
-# For information on usage and redistribution, and for a DISCLAIMER OF ALL
-# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
-# Copyright (c) 1997-2009 Miller Puckette.
-
-package provide dialog_iemgui 0.1
-
-namespace eval ::dialog_iemgui:: {
- variable define_min_flashhold 50
- variable define_min_flashbreak 10
- variable define_min_fontsize 4
-
- namespace export pdtk_iemgui_dialog
-}
-
-# TODO convert Init/No Init and Steady on click/Jump on click to checkbuttons
-
-proc ::dialog_iemgui::clip_dim {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_wdt [concat iemgui_wdt_$vid]
- global $var_iemgui_wdt
- set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
- global $var_iemgui_min_wdt
- set var_iemgui_hgt [concat iemgui_hgt_$vid]
- global $var_iemgui_hgt
- set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
- global $var_iemgui_min_hgt
-
- if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} {
- set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt]
- $mytoplevel.dim.w_ent configure -textvariable $var_iemgui_wdt
- }
- if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} {
- set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt]
- $mytoplevel.dim.h_ent configure -textvariable $var_iemgui_hgt
- }
-}
-
-proc ::dialog_iemgui::clip_num {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_num [concat iemgui_num_$vid]
- global $var_iemgui_num
-
- if {[eval concat $$var_iemgui_num] > 2000} {
- set $var_iemgui_num 2000
- $mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
- }
- if {[eval concat $$var_iemgui_num] < 1} {
- set $var_iemgui_num 1
- $mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
- }
-}
-
-proc ::dialog_iemgui::sched_rng {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
- global $var_iemgui_min_rng
- set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
- global $var_iemgui_max_rng
- set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
- global $var_iemgui_rng_sch
-
- variable define_min_flashhold
- variable define_min_flashbreak
-
- if {[eval concat $$var_iemgui_rng_sch] == 2} {
- if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} {
- set hhh [eval concat $$var_iemgui_min_rng]
- set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng]
- set $var_iemgui_max_rng $hhh
- $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 $define_min_flashhold
- $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
- }
- if {[eval concat $$var_iemgui_min_rng] < $define_min_flashbreak} {
- set $var_iemgui_min_rng $define_min_flashbreak
- $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
- }
- }
- if {[eval concat $$var_iemgui_rng_sch] == 1} {
- if {[eval concat $$var_iemgui_min_rng] == 0.0} {
- set $var_iemgui_min_rng 1.0
- $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
- }
- }
-}
-
-proc ::dialog_iemgui::verify_rng {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
- global $var_iemgui_min_rng
- set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
- global $var_iemgui_max_rng
- set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
- global $var_iemgui_lin0_log1
-
- if {[eval concat $$var_iemgui_lin0_log1] == 1} {
- if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} {
- set $var_iemgui_max_rng 1.0
- $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
- }
- if {[eval concat $$var_iemgui_max_rng] > 0} {
- if {[eval concat $$var_iemgui_min_rng] <= 0} {
- set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01]
- $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
- }
- } else {
- if {[eval concat $$var_iemgui_min_rng] > 0} {
- set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01]
- $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
- }
- }
- }
-}
-
-proc ::dialog_iemgui::clip_fontsize {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
- global $var_iemgui_gn_fs
-
- variable define_min_fontsize
-
- if {[eval concat $$var_iemgui_gn_fs] < $define_min_fontsize} {
- set $var_iemgui_gn_fs $define_min_fontsize
- $mytoplevel.label.fs_ent configure -textvariable $var_iemgui_gn_fs
- }
-}
-
-proc ::dialog_iemgui::set_col_example {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_bcol [concat iemgui_bcol_$vid]
- global $var_iemgui_bcol
- set var_iemgui_fcol [concat iemgui_fcol_$vid]
- global $var_iemgui_fcol
- set var_iemgui_lcol [concat iemgui_lcol_$vid]
- global $var_iemgui_lcol
-
- $mytoplevel.colors.sections.lb_bk configure \
- -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]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]]
-
- if { [eval concat $$var_iemgui_fcol] >= 0 } {
- $mytoplevel.colors.sections.fr_bk configure \
- -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_fcol]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]]
- } else {
- $mytoplevel.colors.sections.fr_bk configure \
- -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_bcol]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]}
-}
-
-proc ::dialog_iemgui::preset_col {mytoplevel presetcol} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
- global $var_iemgui_l2_f1_b0
- set var_iemgui_bcol [concat iemgui_bcol_$vid]
- global $var_iemgui_bcol
- set var_iemgui_fcol [concat iemgui_fcol_$vid]
- global $var_iemgui_fcol
- set var_iemgui_lcol [concat iemgui_lcol_$vid]
- global $var_iemgui_lcol
-
- if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol }
- if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol }
- if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol }
- ::dialog_iemgui::set_col_example $mytoplevel
-}
-
-proc ::dialog_iemgui::choose_col_bkfrlb {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
- global $var_iemgui_l2_f1_b0
- set var_iemgui_bcol [concat iemgui_bcol_$vid]
- global $var_iemgui_bcol
- set var_iemgui_fcol [concat iemgui_fcol_$vid]
- global $var_iemgui_fcol
- set var_iemgui_lcol [concat iemgui_lcol_$vid]
- global $var_iemgui_lcol
-
- if {[eval concat $$var_iemgui_l2_f1_b0] == 0} {
- set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC]
- set helpstring [tk_chooseColor -title [_ "Background color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]]
- if { $helpstring ne "" } {
- set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"]
- set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] }
- }
- if {[eval concat $$var_iemgui_l2_f1_b0] == 1} {
- set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC]
- set helpstring [tk_chooseColor -title [_ "Foreground color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]]
- if { $helpstring ne "" } {
- set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"]
- set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] }
- }
- if {[eval concat $$var_iemgui_l2_f1_b0] == 2} {
- set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC]
- set helpstring [tk_chooseColor -title [_ "Label color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]]
- if { $helpstring ne "" } {
- set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"]
- set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] }
- }
- ::dialog_iemgui::set_col_example $mytoplevel
-}
-
-proc ::dialog_iemgui::lilo {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
- global $var_iemgui_lin0_log1
- set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
- global $var_iemgui_lilo0
- set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
- global $var_iemgui_lilo1
-
- ::dialog_iemgui::sched_rng $mytoplevel
-
- if {[eval concat $$var_iemgui_lin0_log1] == 0} {
- set $var_iemgui_lin0_log1 1
- $mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo1]
- ::dialog_iemgui::verify_rng $mytoplevel
- ::dialog_iemgui::sched_rng $mytoplevel
- } else {
- set $var_iemgui_lin0_log1 0
- $mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo0]
- }
-}
-
-proc ::dialog_iemgui::toggle_font {mytoplevel gn_f} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
- global $var_iemgui_gn_f
-
- set $var_iemgui_gn_f $gn_f
-
- switch -- $gn_f {
- 0 { set current_font $::font_family}
- 1 { set current_font "Helvetica" }
- 2 { set current_font "Times" }
- }
- set current_font_spec "{$current_font} 16 $::font_weight"
-
- $mytoplevel.label.fontpopup_label configure -text $current_font \
- -font $current_font_spec
- $mytoplevel.label.name_entry configure -font $current_font_spec
- $mytoplevel.colors.sections.fr_bk configure -font $current_font_spec
- $mytoplevel.colors.sections.lb_bk configure -font $current_font_spec
-}
-
-proc ::dialog_iemgui::lb {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
- global $var_iemgui_loadbang
-
- if {[eval concat $$var_iemgui_loadbang] == 0} {
- set $var_iemgui_loadbang 1
- $mytoplevel.para.lb configure -text [_ "Init"]
- } else {
- set $var_iemgui_loadbang 0
- $mytoplevel.para.lb configure -text [_ "No init"]
- }
-}
-
-proc ::dialog_iemgui::stdy_jmp {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_steady [concat iemgui_steady_$vid]
- global $var_iemgui_steady
-
- if {[eval concat $$var_iemgui_steady]} {
- set $var_iemgui_steady 0
- $mytoplevel.para.stdy_jmp configure -text [_ "Jump on click"]
- } else {
- set $var_iemgui_steady 1
- $mytoplevel.para.stdy_jmp configure -text [_ "Steady on click"]
- }
-}
-
-proc ::dialog_iemgui::apply {mytoplevel} {
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_wdt [concat iemgui_wdt_$vid]
- global $var_iemgui_wdt
- set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
- global $var_iemgui_min_wdt
- set var_iemgui_hgt [concat iemgui_hgt_$vid]
- global $var_iemgui_hgt
- set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
- global $var_iemgui_min_hgt
- set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
- global $var_iemgui_min_rng
- set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
- global $var_iemgui_max_rng
- set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
- global $var_iemgui_lin0_log1
- set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
- global $var_iemgui_lilo0
- set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
- global $var_iemgui_lilo1
- set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
- global $var_iemgui_loadbang
- set var_iemgui_num [concat iemgui_num_$vid]
- global $var_iemgui_num
- set var_iemgui_steady [concat iemgui_steady_$vid]
- global $var_iemgui_steady
- set var_iemgui_snd [concat iemgui_snd_$vid]
- global $var_iemgui_snd
- set var_iemgui_rcv [concat iemgui_rcv_$vid]
- global $var_iemgui_rcv
- set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
- global $var_iemgui_gui_nam
- set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
- global $var_iemgui_gn_dx
- set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
- global $var_iemgui_gn_dy
- set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
- global $var_iemgui_gn_f
- set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
- global $var_iemgui_gn_fs
- set var_iemgui_bcol [concat iemgui_bcol_$vid]
- global $var_iemgui_bcol
- set var_iemgui_fcol [concat iemgui_fcol_$vid]
- global $var_iemgui_fcol
- set var_iemgui_lcol [concat iemgui_lcol_$vid]
- global $var_iemgui_lcol
-
- ::dialog_iemgui::clip_dim $mytoplevel
- ::dialog_iemgui::clip_num $mytoplevel
- ::dialog_iemgui::sched_rng $mytoplevel
- ::dialog_iemgui::verify_rng $mytoplevel
- ::dialog_iemgui::sched_rng $mytoplevel
- ::dialog_iemgui::clip_fontsize $mytoplevel
-
- if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]}
- if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]}
- if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty"
- } else {
- set hhhgui_nam [eval concat $$var_iemgui_gui_nam]}
-
- if {[string index $hhhsnd 0] == "$"} {
- set hhhsnd [string replace $hhhsnd 0 0 #] }
- if {[string index $hhhrcv 0] == "$"} {
- set hhhrcv [string replace $hhhrcv 0 0 #] }
- if {[string index $hhhgui_nam 0] == "$"} {
- set hhhgui_nam [string replace $hhhgui_nam 0 0 #] }
-
- 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] \
- [eval concat $$var_iemgui_min_rng] \
- [eval concat $$var_iemgui_max_rng] \
- [eval concat $$var_iemgui_lin0_log1] \
- [eval concat $$var_iemgui_loadbang] \
- [eval concat $$var_iemgui_num] \
- $hhhsnd \
- $hhhrcv \
- $hhhgui_nam \
- [eval concat $$var_iemgui_gn_dx] \
- [eval concat $$var_iemgui_gn_dy] \
- [eval concat $$var_iemgui_gn_f] \
- [eval concat $$var_iemgui_gn_fs] \
- [eval concat $$var_iemgui_bcol] \
- [eval concat $$var_iemgui_fcol] \
- [eval concat $$var_iemgui_lcol] \
- [eval concat $$var_iemgui_steady]]
-}
-
-
-proc ::dialog_iemgui::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_iemgui::ok {mytoplevel} {
- ::dialog_iemgui::apply $mytoplevel
- ::dialog_iemgui::cancel $mytoplevel
-}
-
-proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
- wdt min_wdt wdt_label \
- hgt min_hgt hgt_label \
- rng_header min_rng min_rng_label max_rng \
- max_rng_label rng_sched \
- lin0_log1 lilo0_label lilo1_label \
- loadbang steady num_label num \
- snd rcv \
- gui_name \
- gn_dx gn_dy gn_f gn_fs \
- bcol fcol lcol} {
-
- set vid [string trimleft $mytoplevel .]
-
- set var_iemgui_wdt [concat iemgui_wdt_$vid]
- global $var_iemgui_wdt
- set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
- global $var_iemgui_min_wdt
- set var_iemgui_hgt [concat iemgui_hgt_$vid]
- global $var_iemgui_hgt
- set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
- global $var_iemgui_min_hgt
- set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
- global $var_iemgui_min_rng
- set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
- global $var_iemgui_max_rng
- set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
- global $var_iemgui_rng_sch
- set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
- global $var_iemgui_lin0_log1
- set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
- global $var_iemgui_lilo0
- set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
- global $var_iemgui_lilo1
- set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
- global $var_iemgui_loadbang
- set var_iemgui_num [concat iemgui_num_$vid]
- global $var_iemgui_num
- set var_iemgui_steady [concat iemgui_steady_$vid]
- global $var_iemgui_steady
- set var_iemgui_snd [concat iemgui_snd_$vid]
- global $var_iemgui_snd
- set var_iemgui_rcv [concat iemgui_rcv_$vid]
- global $var_iemgui_rcv
- set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
- global $var_iemgui_gui_nam
- set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
- global $var_iemgui_gn_dx
- set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
- global $var_iemgui_gn_dy
- set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
- global $var_iemgui_gn_f
- set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
- global $var_iemgui_gn_fs
- set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
- global $var_iemgui_l2_f1_b0
- set var_iemgui_bcol [concat iemgui_bcol_$vid]
- global $var_iemgui_bcol
- set var_iemgui_fcol [concat iemgui_fcol_$vid]
- global $var_iemgui_fcol
- set var_iemgui_lcol [concat iemgui_lcol_$vid]
- global $var_iemgui_lcol
-
- set $var_iemgui_wdt $wdt
- set $var_iemgui_min_wdt $min_wdt
- set $var_iemgui_hgt $hgt
- set $var_iemgui_min_hgt $min_hgt
- set $var_iemgui_min_rng $min_rng
- set $var_iemgui_max_rng $max_rng
- set $var_iemgui_rng_sch $rng_sched
- set $var_iemgui_lin0_log1 $lin0_log1
- set $var_iemgui_lilo0 $lilo0_label
- set $var_iemgui_lilo1 $lilo1_label
- set $var_iemgui_loadbang $loadbang
- set $var_iemgui_num $num
- set $var_iemgui_steady $steady
- if {$snd == "empty"} {set $var_iemgui_snd [format ""]
- } else {set $var_iemgui_snd [format "%s" $snd]}
- if {$rcv == "empty"} {set $var_iemgui_rcv [format ""]
- } else {set $var_iemgui_rcv [format "%s" $rcv]}
- if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""]
- } else {set $var_iemgui_gui_nam [format "%s" $gui_name]}
-
- if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} {
- set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] }
- if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} {
- set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] }
- if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} {
- set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] }
- set $var_iemgui_gn_dx $gn_dx
- set $var_iemgui_gn_dy $gn_dy
- set $var_iemgui_gn_f $gn_f
- set $var_iemgui_gn_fs $gn_fs
-
- set $var_iemgui_bcol $bcol
- set $var_iemgui_fcol $fcol
- set $var_iemgui_lcol $lcol
-
- set $var_iemgui_l2_f1_b0 0
-
- toplevel $mytoplevel -class DialogWindow
- wm title $mytoplevel [format [_ "%s Properties"] $mainheader]
- 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.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
- label $mytoplevel.dim.h_lab -text [_ $hgt_label] -width 6
- entry $mytoplevel.dim.h_ent -textvariable $var_iemgui_hgt -width 5
- pack $mytoplevel.dim.head -side top
- pack $mytoplevel.dim.w_lab $mytoplevel.dim.w_ent $mytoplevel.dim.dummy1 -side left
- if { $hgt_label ne "empty" } {
- pack $mytoplevel.dim.h_lab $mytoplevel.dim.h_ent -side left}
-
- frame $mytoplevel.rng
- pack $mytoplevel.rng -side top
- 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
- label $mytoplevel.rng.max_lab -text [_ $max_rng_label] -width 8
- entry $mytoplevel.rng.max_ent -textvariable $var_iemgui_max_rng -width 9
- if { $rng_header ne "empty" } {
- pack $mytoplevel.rng.head -side top
- if { $min_rng_label ne "empty" } {
- pack $mytoplevel.rng.min_lab $mytoplevel.rng.min_ent -side left}
- if { $max_rng_label ne "empty" } {
- pack $mytoplevel.rng.dummy1 \
- $mytoplevel.rng.max_lab $mytoplevel.rng.max_ent -side left} }
-
- if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } {
- label $mytoplevel.space1 -text ""
- pack $mytoplevel.space1 -side top }
-
- frame $mytoplevel.para
- pack $mytoplevel.para -side top
- label $mytoplevel.para.dummy2 -text "" -width 1
- label $mytoplevel.para.dummy3 -text "" -width 1
- if {[eval concat $$var_iemgui_lin0_log1] == 0} {
- button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo0]] -width 5 \
- -command "::dialog_iemgui::lilo $mytoplevel" }
- if {[eval concat $$var_iemgui_lin0_log1] == 1} {
- button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo1]] -width 5 \
- -command "::dialog_iemgui::lilo $mytoplevel" }
- if {[eval concat $$var_iemgui_loadbang] == 0} {
- button $mytoplevel.para.lb -text [_ "No init"] \
- -command "::dialog_iemgui::lb $mytoplevel" }
- if {[eval concat $$var_iemgui_loadbang] == 1} {
- button $mytoplevel.para.lb -text [_ "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"] }
- if {[eval concat $$var_iemgui_steady] == 1} {
- button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
- -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} {
- pack $mytoplevel.para.dummy2 $mytoplevel.para.lb -side left -expand 1}
- if {[eval concat $$var_iemgui_num] > 0} {
- pack $mytoplevel.para.dummy3 $mytoplevel.para.num_lab $mytoplevel.para.num_ent -side left -expand 1}
- if {[eval concat $$var_iemgui_steady] >= 0} {
- pack $mytoplevel.para.dummy3 $mytoplevel.para.stdy_jmp -side left -expand 1}
-
- frame $mytoplevel.spacer0 -height 4
- pack $mytoplevel.spacer0 -side top
-
- 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 -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 \
- -fill x -expand 1
- }
-
- frame $mytoplevel.s_r.receive
- 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 \
- -fill x -expand 1
- }
-
- # get the current font name from the int given from C-space (gn_f)
- set current_font $::font_family
- if {[eval concat $$var_iemgui_gn_f] == 1} \
- { set current_font "Helvetica" }
- if {[eval concat $$var_iemgui_gn_f] == 2} \
- { set current_font "Times" }
-
- frame $mytoplevel.spacer1 -height 7
- pack $mytoplevel.spacer1 -side top
-
- 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]
- 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"]
- 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"]
- 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
-
- 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} 16 %s} $::font_family $::font_weight] \
- -command "::dialog_iemgui::toggle_font $mytoplevel 0"
- $mytoplevel.popup add command \
- -label "Helvetica" \
- -font [format {Helvetica 16 %s} $::font_weight] \
- -command "::dialog_iemgui::toggle_font $mytoplevel 1"
- $mytoplevel.popup add command \
- -label "Times" \
- -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]
-
- frame $mytoplevel.spacer2 -height 7
- pack $mytoplevel.spacer2 -side top
-
- labelframe $mytoplevel.colors -borderwidth 1 -text [_ "Colors"]
- pack $mytoplevel.colors -fill x -ipadx 5 -ipady 4
-
- 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
- radiobutton $mytoplevel.colors.select.radio1 -value 1 -variable \
- $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
- if { [eval concat $$var_iemgui_fcol] >= 0 } {
- pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio1 \
- $mytoplevel.colors.select.radio2 -side left
- } else {
- pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio2 -side left
- }
-
- frame $mytoplevel.colors.sections
- pack $mytoplevel.colors.sections -side top
- button $mytoplevel.colors.sections.but -text [_ "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
- if { [eval concat $$var_iemgui_fcol] >= 0 } {
- label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
- -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_fcol]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
- -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
- } else {
- label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
- -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_bcol]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
- -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
- }
- label $mytoplevel.colors.sections.lb_bk -text [_ "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]] \
- -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
- -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
- pack $mytoplevel.colors.sections.lb_bk $mytoplevel.colors.sections.fr_bk \
- -side right -anchor e -expand yes -fill both -pady 7
-
- # color scheme by Mary Ann Benedetto http://piR2.org
- frame $mytoplevel.colors.r1
- pack $mytoplevel.colors.r1 -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9} \
- hexcol { 0xFFFFFF 0xDFDFDF 0xBBBBBB 0xFFC7C6 0xFFE3C6 \
- 0xFEFFC6 0xC6FFC7 0xc6FEFF 0xC7C6FF 0xE3C6FF } \
- {
- label $mytoplevel.colors.r1.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $mytoplevel.colors.r1.c$i <Button> [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
- }
- pack $mytoplevel.colors.r1.c0 $mytoplevel.colors.r1.c1 $mytoplevel.colors.r1.c2 $mytoplevel.colors.r1.c3 \
- $mytoplevel.colors.r1.c4 $mytoplevel.colors.r1.c5 $mytoplevel.colors.r1.c6 $mytoplevel.colors.r1.c7 \
- $mytoplevel.colors.r1.c8 $mytoplevel.colors.r1.c9 -side left
-
- frame $mytoplevel.colors.r2
- pack $mytoplevel.colors.r2 -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9 } \
- hexcol { 0x9F9F9F 0x7C7C7C 0x606060 0xFF0400 0xFF8300 \
- 0xFAFF00 0x00FF04 0x00FAFF 0x0400FF 0x9C00FF } \
- {
- label $mytoplevel.colors.r2.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $mytoplevel.colors.r2.c$i <Button> \
- [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
- }
- pack $mytoplevel.colors.r2.c0 $mytoplevel.colors.r2.c1 $mytoplevel.colors.r2.c2 $mytoplevel.colors.r2.c3 \
- $mytoplevel.colors.r2.c4 $mytoplevel.colors.r2.c5 $mytoplevel.colors.r2.c6 $mytoplevel.colors.r2.c7 \
- $mytoplevel.colors.r2.c8 $mytoplevel.colors.r2.c9 -side left
-
- frame $mytoplevel.colors.r3
- pack $mytoplevel.colors.r3 -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9 } \
- hexcol { 0x404040 0x202020 0x000000 0x551312 0x553512 \
- 0x535512 0x0F4710 0x0E4345 0x131255 0x2F004D } \
- {
- label $mytoplevel.colors.r3.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $mytoplevel.colors.r3.c$i <Button> \
- [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
- }
- pack $mytoplevel.colors.r3.c0 $mytoplevel.colors.r3.c1 $mytoplevel.colors.r3.c2 $mytoplevel.colors.r3.c3 \
- $mytoplevel.colors.r3.c4 $mytoplevel.colors.r3.c5 $mytoplevel.colors.r3.c6 $mytoplevel.colors.r3.c7 \
- $mytoplevel.colors.r3.c8 $mytoplevel.colors.r3.c9 -side left
-
- frame $mytoplevel.cao -pady 10
- pack $mytoplevel.cao -side top -expand 1 -fill x
- button $mytoplevel.cao.cancel -text [_ "Cancel"] \
- -command "::dialog_iemgui::cancel $mytoplevel"
- 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
- focus $mytoplevel.dim.w_ent
-}
-
diff --git a/pd/tcl/dialog_message.tcl b/pd/tcl/dialog_message.tcl
deleted file mode 100644
index 107f1095c08e73a3ad893f7b2fb1f4eca3b883b2..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_message.tcl
+++ /dev/null
@@ -1,85 +0,0 @@
-# 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
deleted file mode 100644
index 450d29388115addca56403fea3f09f3762c11a83..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_midi.tcl
+++ /dev/null
@@ -1,351 +0,0 @@
-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
-# very unreadable
-
-
-####################### midi dialog ##################
-
-proc ::dialog_midi::apply {mytoplevel} {
- global midi_indev1 midi_indev2 midi_indev3 midi_indev4
- global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
- global midi_alsain midi_alsaout
-
- pdsend "pd midi-dialog \
- $midi_indev1 \
- $midi_indev2 \
- $midi_indev3 \
- $midi_indev4 \
- $midi_outdev1 \
- $midi_outdev2 \
- $midi_outdev3 \
- $midi_outdev4 \
- $midi_alsain \
- $midi_alsaout"
-}
-
-proc ::dialog_midi::cancel {mytoplevel} {
- pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_midi::ok {mytoplevel} {
- ::dialog_midi::apply $mytoplevel
- ::dialog_midi::cancel $mytoplevel
-}
-
-# callback from popup menu
-proc midi_popup_action {buttonname varname devlist index} {
- global midi_indevlist midi_outdevlist $varname
- $buttonname configure -text [lindex $devlist $index]
- set $varname $index
-}
-
-# create a popup menu
-proc midi_popup {name buttonname varname devlist} {
- if [winfo exists $name.popup] {destroy $name.popup}
- menu $name.popup -tearoff false
- if {$::windowingsystem eq "win32"} {
- $name.popup configure -font menuFont
- }
-# puts stderr [concat $devlist ]
- for {set x 0} {$x<[llength $devlist]} {incr x} {
- $name.popup add command -label [lindex $devlist $x] \
- -command [list midi_popup_action \
- $buttonname $varname $devlist $x]
- }
- tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
-}
-
-# start a dialog window to select midi devices. "longform" asks us to make
-# controls for opening several devices; if not, we get an extra button to
-# turn longform on and restart the dialog.
-proc ::dialog_midi::pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
- outdev1 outdev2 outdev3 outdev4 longform} {
- global midi_indev1 midi_indev2 midi_indev3 midi_indev4
- global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
- global midi_indevlist midi_outdevlist
- global midi_alsain midi_alsaout
-
- set midi_indev1 $indev1
- set midi_indev2 $indev2
- set midi_indev3 $indev3
- set midi_indev4 $indev4
- set midi_outdev1 $outdev1
- set midi_outdev2 $outdev2
- set midi_outdev3 $outdev3
- set midi_outdev4 $outdev4
- set midi_alsain [llength $midi_indevlist]
- set midi_alsaout [llength $midi_outdevlist]
-
- toplevel $id -class DialogWindow
- wm title $id [_ "MIDI Settings"]
- 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
- button $id.buttonframe.cancel -text [_ "Cancel"]\
- -command "::dialog_midi::cancel $id"
- button $id.buttonframe.apply -text [_ "Apply"]\
- -command "::dialog_midi::apply $id"
- button $id.buttonframe.ok -text [_ "OK"]\
- -command "::dialog_midi::ok $id"
- pack $id.buttonframe.cancel -side left -expand 1
- pack $id.buttonframe.apply -side left -expand 1
- pack $id.buttonframe.ok -side left -expand 1
-
- # input device 1
- frame $id.in1f
- pack $id.in1f -side top
-
- label $id.in1f.l1 -text [_ "Input device 1:"]
- button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
- -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
- pack $id.in1f.l1 $id.in1f.x1 -side left
-
- # input device 2
- if {$longform && [llength $midi_indevlist] > 2} {
- frame $id.in2f
- pack $id.in2f -side top
-
- label $id.in2f.l1 -text [_ "Input device 2:"]
- button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
- -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
- $midi_indevlist]
- pack $id.in2f.l1 $id.in2f.x1 -side left
- }
-
- # input device 3
- if {$longform && [llength $midi_indevlist] > 3} {
- frame $id.in3f
- pack $id.in3f -side top
-
- label $id.in3f.l1 -text [_ "Input device 3:"]
- button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
- -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
- $midi_indevlist]
- pack $id.in3f.l1 $id.in3f.x1 -side left
- }
-
- # input device 4
- if {$longform && [llength $midi_indevlist] > 4} {
- frame $id.in4f
- pack $id.in4f -side top
-
- label $id.in4f.l1 -text [_ "Input device 4:"]
- button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
- -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
- $midi_indevlist]
- pack $id.in4f.l1 $id.in4f.x1 -side left
- }
-
- # output device 1
-
- frame $id.out1f
- pack $id.out1f -side top
- label $id.out1f.l1 -text [_ "Output device 1:"]
- button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
- -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
- $midi_outdevlist]
- pack $id.out1f.l1 $id.out1f.x1 -side left
-
- # output device 2
- if {$longform && [llength $midi_outdevlist] > 2} {
- frame $id.out2f
- pack $id.out2f -side top
- label $id.out2f.l1 -text [_ "Output device 2:"]
- button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
- -command \
- [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
- pack $id.out2f.l1 $id.out2f.x1 -side left
- }
-
- # output device 3
- if {$longform && [llength $midi_outdevlist] > 3} {
- frame $id.out3f
- pack $id.out3f -side top
- label $id.out3f.l1 -text [_ "Output device 3:"]
- button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
- -command \
- [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
- pack $id.out3f.l1 $id.out3f.x1 -side left
- }
-
- # output device 4
- if {$longform && [llength $midi_outdevlist] > 4} {
- frame $id.out4f
- pack $id.out4f -side top
- label $id.out4f.l1 -text [_ "Output device 4:"]
- button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
- -command \
- [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
- pack $id.out4f.l1 $id.out4f.x1 -side left
- }
-
- # if not the "long form" make a button to
- # restart with longform set.
-
- if {$longform == 0} {
- frame $id.longbutton
- pack $id.longbutton -side top
- button $id.longbutton.b -text [_ "Use multiple devices"] \
- -command {pdsend "pd midi-properties 1"}
- pack $id.longbutton.b
- }
-}
-
-proc ::dialog_midi::pdtk_alsa_midi_dialog {id indev1 indev2 indev3 indev4 \
- outdev1 outdev2 outdev3 outdev4 longform alsa} {
- global midi_indev1 midi_indev2 midi_indev3 midi_indev4
- global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
- global midi_indevlist midi_outdevlist
- global midi_alsain midi_alsaout
-
- set midi_indev1 $indev1
- set midi_indev2 $indev2
- set midi_indev3 $indev3
- set midi_indev4 $indev4
- set midi_outdev1 $outdev1
- set midi_outdev2 $outdev2
- set midi_outdev3 $outdev3
- set midi_outdev4 $outdev4
- set midi_alsain [llength $midi_indevlist]
- set midi_alsaout [llength $midi_outdevlist]
-
- toplevel $id
- wm title $id [_ "ALSA MIDI Settings"]
- if {$::windowingsystem eq "aqua"} {$id configure -menu .menubar}
- ::pd_bindings::dialog_bindings $id "midi"
-
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text [_ "Cancel"]\
- -command "::dialog_midi::cancel $id"
- button $id.buttonframe.apply -text [_ "Apply"]\
- -command "::dialog_midi::apply $id"
- button $id.buttonframe.ok -text [_ "OK"]\
- -command "::dialog_midi::ok $id"
- pack $id.buttonframe.cancel -side left -expand 1
- pack $id.buttonframe.apply -side left -expand 1
- pack $id.buttonframe.ok -side left -expand 1
-
- frame $id.in1f
- pack $id.in1f -side top
-
- if {$alsa == 0} {
- # input device 1
- label $id.in1f.l1 -text [_ "Input device 1:"]
- button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
- -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
- pack $id.in1f.l1 $id.in1f.x1 -side left
-
- # input device 2
- if {$longform && [llength $midi_indevlist] > 2} {
- frame $id.in2f
- pack $id.in2f -side top
-
- label $id.in2f.l1 -text [_ "Input device 2:"]
- button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
- -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
- $midi_indevlist]
- pack $id.in2f.l1 $id.in2f.x1 -side left
- }
-
- # input device 3
- if {$longform && [llength $midi_indevlist] > 3} {
- frame $id.in3f
- pack $id.in3f -side top
-
- label $id.in3f.l1 -text [_ "Input device 3:"]
- button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
- -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
- $midi_indevlist]
- pack $id.in3f.l1 $id.in3f.x1 -side left
- }
-
- # input device 4
- if {$longform && [llength $midi_indevlist] > 4} {
- frame $id.in4f
- pack $id.in4f -side top
-
- label $id.in4f.l1 -text [_ "Input device 4:"]
- button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
- -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
- $midi_indevlist]
- pack $id.in4f.l1 $id.in4f.x1 -side left
- }
-
- # output device 1
-
- frame $id.out1f
- pack $id.out1f -side top
- label $id.out1f.l1 -text [_ "Output device 1:"]
- button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
- -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
- $midi_outdevlist]
- pack $id.out1f.l1 $id.out1f.x1 -side left
-
- # output device 2
- if {$longform && [llength $midi_outdevlist] > 2} {
- frame $id.out2f
- pack $id.out2f -side top
- label $id.out2f.l1 -text [_ "Output device 2:"]
- button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
- -command \
- [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
- pack $id.out2f.l1 $id.out2f.x1 -side left
- }
-
- # output device 3
- if {$longform && [llength $midi_outdevlist] > 3} {
- frame $id.out3f
- pack $id.out3f -side top
- label $id.out3f.l1 -text [_ "Output device 3:"]
- button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
- -command \
- [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
- pack $id.out3f.l1 $id.out3f.x1 -side left
- }
-
- # output device 4
- if {$longform && [llength $midi_outdevlist] > 4} {
- frame $id.out4f
- pack $id.out4f -side top
- label $id.out4f.l1 -text [_ "Output device 4:"]
- button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
- -command \
- [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
- pack $id.out4f.l1 $id.out4f.x1 -side left
- }
-
- # if not the "long form" make a button to
- # restart with longform set.
-
- if {$longform == 0} {
- frame $id.longbutton
- pack $id.longbutton -side top
- button $id.longbutton.b -text [_ "Use multiple ALSA devices"] \
- -command {pdsend "pd midi-properties 1"}
- pack $id.longbutton.b
- }
- }
- if {$alsa} {
- label $id.in1f.l1 -text [_ "In Ports:"]
- entry $id.in1f.x1 -textvariable midi_alsain -width 4
- pack $id.in1f.l1 $id.in1f.x1 -side left
- label $id.in1f.l2 -text [_ "Out Ports:"]
- entry $id.in1f.x2 -textvariable midi_alsaout -width 4
- pack $id.in1f.l2 $id.in1f.x2 -side left
- }
-}
diff --git a/pd/tcl/dialog_path.tcl b/pd/tcl/dialog_path.tcl
deleted file mode 100644
index 40a306bae4fbb2d4849cae0b2b18aed12a5af7eb..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_path.tcl
+++ /dev/null
@@ -1,70 +0,0 @@
-
-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
deleted file mode 100644
index 52c5f647429f3cc8ff76cc9aeb825a07e3542360..0000000000000000000000000000000000000000
--- a/pd/tcl/dialog_startup.tcl
+++ /dev/null
@@ -1,96 +0,0 @@
-
-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
deleted file mode 100644
index bcec1fc568e51d33e598b22480ab54353ede958f..0000000000000000000000000000000000000000
--- a/pd/tcl/helpbrowser.tcl
+++ /dev/null
@@ -1,272 +0,0 @@
-
-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
deleted file mode 100644
index c34baf6d9842ff15326f2698517bbdc3044c2b41..0000000000000000000000000000000000000000
--- a/pd/tcl/opt_parser.tcl
+++ /dev/null
@@ -1,86 +0,0 @@
-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
- variable optbehavior
- array unset optlist ; array set optlist {}
- array unset optbehavior ; array set optbehavior {}
- foreach item $optdata {
- 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($optName) $varlist
- set optbehavior($optName) $behavior
- }
- }
-}
-
-proc opt_parser::get_options {argv {opts {}}} {
- # 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]
- if {$optbehavior($optName) == {lappend}} {
- for {set i 1} {$i < [llength $optlist($optName)]} {incr i} {
- uplevel [list set [lindex $optlist($optName) $i] [list]]
- }
- }
- }
-
- # here will be appended non-options arguments
- set residualArgs {}
-
- set argc [llength $argv]
- for {set i 0} {$i < $argc} {} {
- # get i-th arg
- set optName [lindex $argv $i]
- incr i
-
- # if it's not an option, stop here, and add to residualArgs
- if {![regexp ^$optprefix $optName]} {
- lappend residualArgs $optName
- continue
- }
-
- if {[info exists optlist($optName)]} {
- set varlist $optlist($optName)
- uplevel [list set [lindex $optlist($optName) 0] 1]
- set n_required_opt_args [expr {-1+[llength $varlist]}]
- set j 1
- while {$n_required_opt_args > 0} {
- incr n_required_opt_args -1
- if {$i >= $argc} {
- return -code error "not enough arguments for option $optName"
- }
- uplevel [list $optbehavior($optName) [lindex $varlist $j] [lindex $argv $i]]
- incr j
- incr i
- }
- } else {
- if {$ignore_unknown_flags} {
- lappend residualArgs $argv_i
- continue
- } else {
- return -code error "unknown option: $optName"
- }
- }
- }
- return $residualArgs
-}
diff --git a/pd/tcl/pd-gui.tcl b/pd/tcl/pd-gui.tcl
deleted file mode 100644
index d379c459d59fcfded69843ca039110940c2ebb94..0000000000000000000000000000000000000000
--- a/pd/tcl/pd-gui.tcl
+++ /dev/null
@@ -1,735 +0,0 @@
-#!/bin/sh
-# This line continues for Tcl, but is a single line for 'sh' \
- exec wish "$0" -- ${1+"$@"}
-# For information on usage and redistribution, and for a DISCLAIMER OF ALL
-# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
-# Copyright (c) 1997-2009 Miller Puckette.
-
-# "." 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.
-if { [catch {wm withdraw .} fid] } { exit 2 }
-
-package require Tcl 8.3
-package require Tk
-#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]]]
-package require pd_connect
-package require pd_menus
-package require pd_bindings
-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
-namespace import ::dialog_array::pdtk_array_listview_fillpage
-namespace import ::dialog_array::pdtk_array_listview_setpage
-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
-set TCL_BUGFIX_VERSION 0
-
-# for testing which platform we are running on ("aqua", "win32", or "x11")
-set windowingsystem ""
-
-# 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"
-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 6 11
- 9 6 12
- 10 7 13
- 12 9 16
- 14 8 17
- 16 10 20
- 18 11 22
- 24 15 25
- 30 18 37
- 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 {}
-# 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 .
-# store that last 5 files that were opened
-set recentfiles_list {}
-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
-# 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
-#
-# these are preliminary ideas, we'll change them as we work things out:
-# - when possible use "" doublequotes to delimit messages
-# - use '$::myvar' instead of 'global myvar'
-# - for the sake of clarity, there should not be any inline code, everything
-# should be in a proc that is ultimately triggered from main()
-# - 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
-# $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
-#----------------------------
-# pdtk_ pd -> pd-gui API (i.e. called from 'pd')
-# pdsend pd-gui -> pd API (sends a message to 'pd' using pdsend)
-
-# ------------------------------------------------------------------------------
-# init functions
-
-# root paths to find Pd's files where they are installed
-proc set_pd_paths {} {
- set ::sys_guidir [file normalize [file dirname [info script]]]
- set ::sys_libdir [file normalize [file join $::sys_guidir ".."]]
-}
-
-proc init_for_platform {} {
- # we are not using Tk scaling, so fix it to 1 on all platforms. This
- # guarantees that patches will be pixel-exact on every platform
- tk scaling 1
-
- 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}
- set ::tk::dialog::file::showHiddenBtn 1
- set ::tk::dialog::file::showHiddenVar 0
- # set file types that open/save recognize
- set ::filetypes \
- [list \
- [list [_ "Associated Files"] {.pd .pat .mxt} ] \
- [list [_ "Pd Files"] {.pd} ] \
- [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 \
- [list [_ "Associated Files"] {.pd .pat .mxt} ] \
- [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 \
- [list [_ "Associated Files"] {.pd .pat .mxt} ] \
- [list [_ "Pd Files"] {.pd} ] \
- [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"
- }
- }
-}
-
-# ------------------------------------------------------------------------------
-# locale handling
-
-# official GNU gettext msgcat shortcut
-proc _ {s} {return [::msgcat::mc $s]}
-
-proc load_locale {} {
- # 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] ]
- }
- }
- ::msgcat::mcload [file join [file dirname [info script]] .. po]
-
- ##--moo: force default system and stdio encoding to UTF-8
- encoding system utf-8
- fconfigure stderr -encoding utf-8
- fconfigure stdout -encoding utf-8
- ##--/moo
-}
-
-# ------------------------------------------------------------------------------
-# font handling
-
-# this proc gets the internal font name associated with each size
-proc get_font_for_size {size} {
- return "::pd_font_${size}"
-}
-
-# searches for a font to use as the default. Tk automatically assigns a
-# monospace font to the name "Courier" (see Tk 'font' docs), but it doesn't
-# 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 {"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
- }
- }
- ::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 {
- ::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 {
- ::pdwindow::post [format \
- [_ "WARNING: Font weight '%s' not found, using default (%s)\n"] \
- $weight $::font_weight]
- }
-}
-
-# creates all the base fonts (i.e. pd_font_8 thru pd_font_36) so that they fit
-# into the metrics given by $::font_fixed_metrics for any given font/weight
-proc fit_font_into_metrics {} {
-# TODO the fonts picked seem too small, probably on fixed width
- foreach {size width height} $::font_fixed_metrics {
- set myfont [get_font_for_size $size]
- font create $myfont -family $::font_family -weight $::font_weight \
- -size [expr {-$height}]
- set height2 $height
- set giveup 0
- 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} {
- ::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
- }
- }
-}
-
-
-# ------------------------------------------------------------------------------
-# procs called directly by pd
-
-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
- 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
- ::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 ######
-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
- }
-}
-
-# ------------------------------------------------------------------------------
-# 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
- }
-}
-
-# ------------------------------------------------------------------------------
-# X11 procs for handling singleton state and getting args from other instances
-
-# first instance
-proc singleton {key} {
- if {![catch { selection get -selection $key }]} {
- return 0
- }
- selection handle -selection $key . "singleton_request"
- selection own -command first_lost -selection $key .
- return 1
-}
-
-proc singleton_request {offset maxbytes} {
-## 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 ${::pdgui::scriptname} ]
- selection own -command first_lost -selection ${::pdgui::scriptname} .
- }
-
-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}]]
-}
-
-# 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 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
- # 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 ${::pdgui::scriptname} .
- }
- } "win32" {
- ## 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
- }
- }
- }
-}
-
-
-# ------------------------------------------------------------------------------
-# 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_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
- }
- }
-}
-
-# ------------------------------------------------------------------------------
-# main
-proc main {argc argv} {
- # TODO Tcl/Tk 8.3 doesn't have [tk windowingsystem]
- set ::windowingsystem [tk windowingsystem]
- tk appname pd-gui
- load_locale
- parse_args $argc $argv
- check_for_running_instances
- set_pd_paths
- init_for_platform
-
- # ::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 $::port $::host
- } else {
- # the GUI is starting first, so create socket and exec 'pd'
- set ::port [::pd_connect::create_socket]
- set pd_exec [file join [file dirname [info script]] ../bin/pd]
- 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)
- }
- }
- ::pdwindow::verbose 0 "------------------ done with main ----------------------\n"
-}
-
-main $::argc $::argv
diff --git a/pd/tcl/pd.ico b/pd/tcl/pd.ico
deleted file mode 100755
index 2da5c243623c9ea56b6faca91b5e687d2c4f62fb..0000000000000000000000000000000000000000
Binary files a/pd/tcl/pd.ico and /dev/null differ
diff --git a/pd/tcl/pd_bindings.tcl b/pd/tcl/pd_bindings.tcl
deleted file mode 100644
index a1c4c57af6387f7ea5e74375fcf721ba04341019..0000000000000000000000000000000000000000
--- a/pd/tcl/pd_bindings.tcl
+++ /dev/null
@@ -1,270 +0,0 @@
-package provide pd_bindings 0.1
-
-package require pd_menucommands
-package require dialog_find
-
-namespace eval ::pd_bindings:: {
- namespace export global_bindings
- namespace export dialog_bindings
- namespace export patch_bindings
-}
-
-# 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 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 window events
-proc ::pd_bindings::class_bindings {} {
- # and the Pd window is in a class to itself
- bind PdWindow <FocusIn> "::pd_bindings::window_focusin %W"
- # 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::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"} {
- # 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 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
- }
-
- 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
-# properties, iemgui properties, canvas properties, data structures
-# properties, Audio setup, and MIDI setup
-proc ::pd_bindings::dialog_bindings {mytoplevel dialogname} {
- variable modifier
-
- 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"
- # 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}
-
- wm protocol $mytoplevel WM_DELETE_WINDOW "dialog_${dialogname}::cancel $mytoplevel"
-}
-
-proc ::pd_bindings::patch_bindings {mytoplevel} {
- variable modifier
- set tkcanvas [tkcanvas_name $mytoplevel]
-
- # TODO move mouse bindings to global and bind to 'all'
-
- # 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 $tkcanvas <MouseWheel> {::pdtk_canvas::scroll %W y %D}
- bind $tkcanvas <Shift-MouseWheel> {::pdtk_canvas::scroll %W x %D}
-
- # "right clicks" are defined differently on each platform
- switch -- $::windowingsystem {
- "aqua" {
- 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 $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 $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
- # on X11, button 2 "pastes" from the X windows clipboard
- 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 $tkcanvas <ButtonPress-3> "pdtk_canvas_rightclick %W %x %y %b"
- bind $tkcanvas <Alt-ButtonPress-1> "pdtk_canvas_mouse %W %x %y %b 3"
- }
- }
-
- # window protocol bindings
- wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"$mytoplevel menuclose 0\""
- bind $tkcanvas <Destroy> "::pd_bindings::window_destroy %W"
-}
-
-
-#------------------------------------------------------------------------------#
-# event handlers
-
-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 {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} {
- # focused_window is used throughout for sending bindings, menu commands,
- # etc. to the correct patch receiver symbol.
- set ::focused_window $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
- }
- 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
-}
-
-proc ::pd_bindings::dialog_configure {mytoplevel} {
-}
-
-proc ::pd_bindings::dialog_focusin {mytoplevel} {
- # TODO disable things on the menus that don't work for dialogs
- ::pd_menus::configure_for_dialog $mytoplevel
-}
-
-# "map" event tells us when the canvas becomes visible, and "unmap",
-# invisible. Invisibility means the Window Manager has minimized us. We
-# 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} {
- pdsend "$mytoplevel map 0"
-}
-
-
-#------------------------------------------------------------------------------#
-# key usage
-
-# 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 }
- "Tab" { set iso ""; set key 9 }
- "Return" { set iso ""; set key 10 }
- "Escape" { set iso ""; set key 27 }
- "Space" { set iso ""; set key 32 }
- "Delete" { set iso ""; set key 127 }
- "KP_Delete" { set iso ""; set key 127 }
- }
- if {$iso ne ""} {
- scan $iso %c key
- }
- # 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
deleted file mode 100644
index 4fa136dd7a2bc77d29d7c211f7ca24994ec84198..0000000000000000000000000000000000000000
--- a/pd/tcl/pd_connect.tcl
+++ /dev/null
@@ -1,96 +0,0 @@
-
-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
- namespace export pdsend
-}
-
-# TODO figure out how to escape { } properly
-
-proc ::pd_connect::configure_socket {sock} {
- 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 {host localhost}} {
- variable pd_socket
- ::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
-}
-
-# if pd-gui opens first, it creates socket and requests a port. The function
-# then returns the portnumber it receives. pd then connects to that port.
-proc ::pd_connect::create_socket {} {
- if {[catch {set sock [socket -server ::pd_connect::from_pd -myaddr localhost 0]}]} {
- puts stderr "ERROR: failed to allocate port, exiting!"
- exit 3
- }
- return [lindex [fconfigure $sock -sockname] 2]
-}
-
-proc ::pd_connect::from_pd {channel clientaddr clientport} {
- variable pd_socket $channel
- ::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 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 \;
- if {[catch {puts $pd_socket $message} errorname]} {
- puts stderr "pdsend errorname: >>$errorname<<"
- error "Not connected to 'pd' process"
- }
-}
-
-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
deleted file mode 100644
index 2423441eeecac656157fa0dc9d10285dda3bd21a..0000000000000000000000000000000000000000
--- a/pd/tcl/pd_guiprefs.tcl
+++ /dev/null
@@ -1,249 +0,0 @@
-#
-# 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
deleted file mode 100644
index 91f562f374b0e37a56b72d7a4fc06108a9467855..0000000000000000000000000000000000000000
--- a/pd/tcl/pd_menucommands.tcl
+++ /dev/null
@@ -1,278 +0,0 @@
-
-package provide pd_menucommands 0.1
-
-namespace eval ::pd_menucommands:: {
- variable untitled_number "1"
-
- namespace export menu_*
-}
-
-# ------------------------------------------------------------------------------
-# functions called from File menu
-
-proc ::pd_menucommands::menu_new {} {
- variable untitled_number
- 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 {} {
- if { ! [file isdirectory $::fileopendir]} {set ::fileopendir $::env(HOME)}
- set files [tk_getOpenFile -defaultextension .pd \
- -multiple true \
- -filetypes $::filetypes \
- -initialdir $::fileopendir]
- if {$files ne ""} {
- foreach filename $files {
- open_file $filename
- }
- set ::fileopendir [file dirname $filename]
- }
-}
-
-proc ::pd_menucommands::menu_print {mytoplevel} {
- set filename [tk_getSaveFile -initialfile pd.ps \
- -defaultextension .ps \
- -filetypes { {{postscript} {.ps}} }]
- if {$filename ne ""} {
- set tkcanvas [tkcanvas_name $mytoplevel]
- $tkcanvas postscript -file $filename
- }
-}
-
-# ------------------------------------------------------------------------------
-# 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}]
-}
-
-# ------------------------------------------------------------------------------
-# generic procs for sending menu events
-
-# 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
- }
- }
-}
-
-# 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 {} {
- ::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 {} {
- if {[winfo exists .font]} {
- raise .font
- } elseif {$::focused_window eq ".pdwindow"} {
- pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1]
- } else {
- pdsend "$::focused_window menufont"
- }
-}
-
-proc ::pd_menucommands::menu_path_dialog {} {
- if {[winfo exists .path]} {
- raise .path
- } else {
- pdsend "pd start-path-dialog"
- }
-}
-
-proc ::pd_menucommands::menu_startup_dialog {} {
- if {[winfo exists .startup]} {
- raise .startup
- } else {
- pdsend "pd start-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 {window} {
- wm iconify [winfo toplevel $window]
-}
-
-proc ::pd_menucommands::menu_maximize {window} {
- wm state [winfo toplevel $window] zoomed
-}
-
-proc ::pd_menucommands::menu_raise_pdwindow {} {
- if {$::focused_window eq ".pdwindow" && [winfo viewable .pdwindow]} {
- lower .pdwindow
- } else {
- wm deiconify .pdwindow
- 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_filenewdir {mytoplevel} {
- # TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
- if {$mytoplevel eq ".pdwindow"} {
- set ::filenewdir $::fileopendir
- } else {
- regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored ::filenewdir
- }
-}
-
-# 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
- }
-}
-
-# ------------------------------------------------------------------------------
-# 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"
- }
-}
-
-# open HTML docs from the menu using the OS-default HTML viewer
-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"} {
- exec rundll32 url.dll,FileProtocolHandler [format "%s" $filename] &
- } else {
- foreach candidate { gnome-open xdg-open sensible-browser iceweasel firefox \
- mozilla galeon konqueror netscape lynx } {
- set browser [lindex [auto_execok $candidate] 0]
- if {[string length $browser] != 0} {
- exec -- sh -c [format "%s '%s'" $browser $filename] &
- break
- }
- }
- }
-}
-
-# ------------------------------------------------------------------------------
-# Mac OS X specific functions
-
-proc ::pd_menucommands::menu_bringalltofront {} {
- # use [winfo children .] here to include windows that are minimized
- foreach item [winfo children .] {
- # get all toplevel windows, exclude menubar windows
- if { [string equal [winfo toplevel $item] $item] && \
- [catch {$item cget -tearoff}]} {
- wm deiconify $item
- }
- }
- wm deiconify .
-}
diff --git a/pd/tcl/pd_menus.tcl b/pd/tcl/pd_menus.tcl
deleted file mode 100644
index 1d4862c19205725970ba0b8469f67bc0cf92de46..0000000000000000000000000000000000000000
--- a/pd/tcl/pd_menus.tcl
+++ /dev/null
@@ -1,607 +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
-
-# 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 ".menubar"
-
- 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"
- 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 "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
- # 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
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-proc ::pd_menus::configure_for_canvas {mytoplevel} {
- variable menubar
- # 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
- if {[$menubar.put type $i] ne "separator"} {
- $menubar.put entryconfigure $i -state normal
- }
- }
- update_undo_on_menu $mytoplevel
-}
-
-proc ::pd_menus::configure_for_dialog {mytoplevel} {
- variable menubar
- # 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
- catch {$menubar.put entryconfigure $i -state disabled }
- }
-}
-
-
-# ------------------------------------------------------------------------------
-# menu building functions
-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 {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} {
- 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 {menu_send $::focused_window cut}
- $mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
- -command {menu_send $::focused_window copy}
- $mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
- -command {menu_send $::focused_window paste}
- $mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
- -command {menu_send $::focused_window duplicate}
- $mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
- -command {menu_send $::focused_window selectall}
- $mymenu add separator
- if {$::windowingsystem eq "aqua"} {
-# $mymenu add command -label [_ "Text Editor"] \
-# -command {menu_texteditor}
- $mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
- -command {menu_font_dialog}
- } else {
-# $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
-# -command {menu_texteditor}
- $mymenu add command -label [_ "Font"] \
- -command {menu_font_dialog}
- }
- $mymenu add command -label [_ "Tidy Up"] \
- -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 set the state of the check box without invoking the menu!
- $mymenu add check -label [_ "Edit Mode"] -accelerator "$accelerator+E" \
- -variable ::editmode_button \
- -command {menu_editmode $::editmode_button}
-}
-
-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 {menu_send_float $::focused_window obj 0}
- $mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
- -command {menu_send_float $::focused_window msg 0}
- $mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
- -command {menu_send_float $::focused_window floatatom 0}
- $mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
- -command {menu_send_float $::focused_window symbolatom 0}
- $mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
- -command {menu_send_float $::focused_window text 0}
- $mymenu add separator
- $mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
- -command {menu_send $::focused_window bng}
- $mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
- -command {menu_send $::focused_window toggle}
- $mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
- -command {menu_send $::focused_window numbox}
- $mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
- -command {menu_send $::focused_window vslider}
- $mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
- -command {menu_send $::focused_window hslider}
- $mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
- -command {menu_send $::focused_window vradio}
- $mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
- -command {menu_send $::focused_window hradio}
- $mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
- -command {menu_send $::focused_window vumeter}
- $mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
- -command {menu_send $::focused_window mycnv}
- $mymenu add separator
- $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} {
- variable accelerator
- $mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
- -command {menu_find_dialog}
- $mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
- -command {menu_send $::focused_window findagain}
- $mymenu add command -label [_ "Find Last Error"] \
- -command {pdsend {pd finderror}}
-}
-
-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 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 $::audio_apilist $x] 1]\
- -command {pdsend "pd audio-setapi $::pd_whichapi"}
- }
-
- 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 $::midi_apilist $x] 1]\
- -command {pdsend "pd midi-setapi $::pd_whichmidiapi"}
- }
- if {$::windowingsystem ne "aqua"} {
- $mymenu add separator
- create_preferences_menu $mymenu.preferences
- $mymenu add cascade -label [_ "Preferences"] -menu $mymenu.preferences
- }
-}
-
-proc ::pd_menus::build_window_menu {mymenu} {
- variable accelerator
- if {$::windowingsystem eq "aqua"} {
- $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 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
-}
-
-proc ::pd_menus::build_help_menu {mymenu} {
- if {$::windowingsystem ne "aqua"} {
- $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 {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 (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 $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 {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 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]
- }
- # 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
-
-# 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_aboutpd}
- $mymenu.apple add separator
- 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"
- # 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"
- $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 {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} {
- 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"
- 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
- $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_array.tcl b/pd/tcl/pdtk_array.tcl
deleted file mode 100644
index 107a722c9176aae68456c7738ad5baf2d9d24a52..0000000000000000000000000000000000000000
--- a/pd/tcl/pdtk_array.tcl
+++ /dev/null
@@ -1,346 +0,0 @@
-package provide pdtk_array 0.1
-
-#### jsarlo #####
-proc pdtk_array_listview_setpage {arrayName page} {
- global pd_array_listview_page
- set pd_array_listview_page($arrayName) $page
-}
-
-proc pdtk_array_listview_changepage {arrayName np} {
- global pd_array_listview_page
- pdtk_array_listview_setpage \
- $arrayName [expr $pd_array_listview_page($arrayName) + $np]
- pdtk_array_listview_fillpage $arrayName
-}
-
-proc pdtk_array_listview_fillpage {arrayName} {
- global pd_array_listview_page
- global pd_array_listview_id
- set windowName [format ".%sArrayWindow" $arrayName]
- set topItem [expr [lindex [$windowName.lb yview] 0] * \
- [$windowName.lb size]]
-
- if {[winfo exists $windowName]} {
- set cmd "$pd_array_listview_id($arrayName) \
- arrayviewlistfillpage \
- $pd_array_listview_page($arrayName) \
- $topItem"
-
- pdsend $cmd
- }
-}
-
-proc pdtk_array_listview_new {id arrayName page} {
- global pd_array_listview_page
- global pd_array_listview_id
- global fontname fontweight
- set pd_array_listview_page($arrayName) $page
- set pd_array_listview_id($arrayName) $id
- set windowName [format ".%sArrayWindow" $arrayName]
- if [winfo exists $windowName] then [destroy $windowName]
- toplevel $windowName
- wm protocol $windowName WM_DELETE_WINDOW \
- "pdtk_array_listview_close $id $arrayName"
- wm title $windowName [concat $arrayName "(list view)"]
- # FIXME
- set font 12
- set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
- -selectmode extended \
- -relief solid -background white -borderwidth 1 \
- -font [format {{%s} %d %s} $fontname $font $fontweight]\
- -yscrollcommand "$windowName.lb.sb set"]
- set $windowName.lb.sb [scrollbar $windowName.lb.sb \
- -command "$windowName.lb yview" -orient vertical]
- place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
- pack $windowName.lb -expand 1 -fill both
- bind $windowName.lb <Double-ButtonPress-1> \
- "pdtk_array_listview_edit $arrayName $page $font"
- # handle copy/paste
- if {[tk windowingsystem] eq "x11"} {
- selection handle $windowName.lb \
- "pdtk_array_listview_lbselection $arrayName"
- } else {
- if {[tk windowingsystem] eq "win32"} {
- bind $windowName.lb <ButtonPress-3> \
- "pdtk_array_listview_popup $arrayName"
- }
- }
- set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
- -command "pdtk_array_listview_changepage $arrayName -1"]
- set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
- -command "pdtk_array_listview_changepage $arrayName 1"]
- pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
- pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
- focus $windowName
-}
-
-proc pdtk_array_listview_lbselection {arrayName off size} {
- set windowName [format ".%sArrayWindow" $arrayName]
- set itemNums [$windowName.lb curselection]
- set cbString ""
- for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- append cbString "\n"
- }
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- set last $cbString
-}
-
-# Win32 uses a popup menu for copy/paste
-proc pdtk_array_listview_popup {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- if [winfo exists $windowName.popup] then [destroy $windowName.popup]
- menu $windowName.popup -tearoff false
- $windowName.popup add command -label {Copy} \
- -command "pdtk_array_listview_copy $arrayName; \
- destroy $windowName.popup"
- $windowName.popup add command -label {Paste} \
- -command "pdtk_array_listview_paste $arrayName; \
- destroy $windowName.popup"
- tk_popup $windowName.popup [winfo pointerx $windowName] \
- [winfo pointery $windowName] 0
-}
-
-proc pdtk_array_listview_copy {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- set itemNums [$windowName.lb curselection]
- set cbString ""
- for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- append cbString "\n"
- }
- set listItem [$windowName.lb get [lindex $itemNums $i]]
- append cbString [string range $listItem \
- [expr [string first ") " $listItem] + 2] \
- end]
- clipboard clear
- clipboard append $cbString
-}
-
-proc pdtk_array_listview_paste {arrayName} {
- global pd_array_listview_page
- global pd_array_listview_pagesize
- set cbString [selection get -selection CLIPBOARD]
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- set itemNum [lindex [$lbName curselection] 0]
- set splitChars ", \n"
- set itemString [split $cbString $splitChars]
- set flag 1
- for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
- if {[lindex $itemString $i] != {}} {
- pdsend "$arrayName [expr $itemNum + \
- [expr $counter + \
- [expr $pd_array_listview_pagesize \
- * $pd_array_listview_page($arrayName)]]] \
- [lindex $itemString $i]"
- incr counter
- set flag 0
- }
- }
-}
-
-proc pdtk_array_listview_edit {arrayName page font} {
- global pd_array_listview_entry
- global fontname fontweight
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- if {[winfo exists $lbName.entry]} {
- pdtk_array_listview_update_entry \
- $arrayName $pd_array_listview_entry($arrayName)
- unset pd_array_listview_entry($arrayName)
- }
- set itemNum [$lbName index active]
- set pd_array_listview_entry($arrayName) $itemNum
- set bbox [$lbName bbox $itemNum]
- set y [expr [lindex $bbox 1] - 4]
- set $lbName.entry [entry $lbName.entry \
- -font [format {{%s} %d %s} $fontname $font $fontweight]]
- $lbName.entry insert 0 []
- place configure $lbName.entry -relx 0 -y $y -relwidth 1
- lower $lbName.entry
- focus $lbName.entry
- bind $lbName.entry <Return> \
- "pdtk_array_listview_update_entry $arrayName $itemNum;"
-}
-
-proc pdtk_array_listview_update_entry {arrayName itemNum} {
- global pd_array_listview_page
- global pd_array_listview_pagesize
- set lbName [format ".%sArrayWindow.lb" $arrayName]
- set splitChars ", \n"
- set itemString [split [$lbName.entry get] $splitChars]
- set flag 1
- for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
- if {[lindex $itemString $i] != {}} {
- pdsend [concat $arrayName [expr $itemNum + \
- [expr $counter + \
- [expr $pd_array_listview_pagesize \
- * $pd_array_listview_page($arrayName)]]] \
- [lindex $itemString $i] \;]
- incr counter
- set flag 0
- }
- }
- pdtk_array_listview_fillpage $arrayName
- destroy $lbName.entry
-}
-
-proc pdtk_array_listview_closeWindow {arrayName} {
- set windowName [format ".%sArrayWindow" $arrayName]
- destroy $windowName
-}
-
-proc pdtk_array_listview_close {id arrayName} {
- pdtk_array_listview_closeWindow $arrayName
- pdsend "$id arrayviewclose"
-}
-##### end jsarlo #####
-
-############ pdtk_array_dialog -- dialog window for arrays #########
-# see comments above (pdtk_gatom_dialog) about variable name handling
-
-proc array_apply {id} {
- # strip "." from the TK id to make a variable name suffix
- set vid [string trimleft $id .]
- # for each variable, make a local variable to hold its name...
- set var_array_name [concat array_name_$vid]
- global $var_array_name
- set var_array_n [concat array_n_$vid]
- global $var_array_n
- set var_array_saveit [concat array_saveit_$vid]
- global $var_array_saveit
- set var_array_drawasrects [concat array_drawasrects_$vid]
- global $var_array_drawasrects
- set var_array_otherflag [concat array_otherflag_$vid]
- global $var_array_otherflag
- set mofo [eval concat $$var_array_name]
- if {[string index $mofo 0] == "$"} {
- set mofo [string replace $mofo 0 0 #] }
-
- set saveit [eval concat $$var_array_saveit]
- set drawasrects [eval concat $$var_array_drawasrects]
-
- pdsend "$id arraydialog $mofo [eval concat $$var_array_n] \
- [expr $saveit + 2 * $drawasrects] [eval concat $$var_array_otherflag]"
-}
-
-# jsarlo
-proc array_viewlist {id} {
- pdsend "$id arrayviewlistnew"
-}
-# end jsarlo
-
-proc array_cancel {id} {
- pdsend "$id cancel"
-}
-
-proc array_ok {id} {
- array_apply $id
- array_cancel $id
-}
-
-proc pdtk_array_dialog {id name n flags newone} {
- set vid [string trimleft $id .]
-
- set var_array_name [concat array_name_$vid]
- global $var_array_name
- set var_array_n [concat array_n_$vid]
- global $var_array_n
- set var_array_saveit [concat array_saveit_$vid]
- global $var_array_saveit
- set var_array_drawasrects [concat array_drawasrects_$vid]
- global $var_array_drawasrects
- set var_array_otherflag [concat array_otherflag_$vid]
- global $var_array_otherflag
-
- set $var_array_name $name
- set $var_array_n $n
- set $var_array_saveit [expr ( $flags & 1 ) != 0]
- set $var_array_drawasrects [expr ( $flags & 2 ) != 0]
- set $var_array_otherflag 0
-
- toplevel $id
- wm title $id {array}
- wm resizable $id 0 0
- wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id]
-
- ::pd_bindings::panel_bindings $id "array"
-
- frame $id.name
- pack $id.name -side top
- label $id.name.label -text "name"
- entry $id.name.entry -textvariable $var_array_name
- pack $id.name.label $id.name.entry -side left
-
- frame $id.n
- pack $id.n -side top
- label $id.n.label -text "size"
- entry $id.n.entry -textvariable $var_array_n
- pack $id.n.label $id.n.entry -side left
-
- checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \
- -anchor w
- pack $id.saveme -side top
-
- frame $id.drawasrects
- pack $id.drawasrects -side top
- radiobutton $id.drawasrects.drawasrects0 -value 0 \
- -variable $var_array_drawasrects \
- -text "draw as points"
- radiobutton $id.drawasrects.drawasrects1 -value 1 \
- -variable $var_array_drawasrects \
- -text "polygon"
- radiobutton $id.drawasrects.drawasrects2 -value 2 \
- -variable $var_array_drawasrects \
- -text "bezier curve"
- pack $id.drawasrects.drawasrects0 -side top -anchor w
- pack $id.drawasrects.drawasrects1 -side top -anchor w
- pack $id.drawasrects.drawasrects2 -side top -anchor w
-
- if {$newone != 0} {
- frame $id.radio
- pack $id.radio -side top
- radiobutton $id.radio.radio0 -value 0 \
- -variable $var_array_otherflag \
- -text "in new graph"
- radiobutton $id.radio.radio1 -value 1 \
- -variable $var_array_otherflag \
- -text "in last graph"
- pack $id.radio.radio0 -side top -anchor w
- pack $id.radio.radio1 -side top -anchor w
- } else {
- checkbutton $id.deleteme -text {delete me} \
- -variable $var_array_otherflag -anchor w
- pack $id.deleteme -side top
- }
- # jsarlo
- if {$newone == 0} {
- button $id.listview -text {View list}\
- -command "array_viewlist $id $name 0"
- pack $id.listview -side left
- }
- # end jsarlo
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text {Cancel}\
- -command "array_cancel $id"
- if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\
- -command "array_apply $id"}
- button $id.buttonframe.ok -text {OK}\
- -command "array_ok $id"
- pack $id.buttonframe.cancel -side left -expand 1
- if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1}
- pack $id.buttonframe.ok -side left -expand 1
-
- $id.name.entry select from 0
- $id.name.entry select adjust end
- focus $id.name.entry
-}
diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl
deleted file mode 100644
index 6db3f1b98da0cdcb4b624513dd09cd29c071497f..0000000000000000000000000000000000000000
--- a/pd/tcl/pdtk_canvas.tcl
+++ /dev/null
@@ -1,386 +0,0 @@
-
-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} {
- 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 $::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>>
-
- wm geometry $mytoplevel $geometry
- 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
- }
-
- ::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) {}
-
- # this should be at the end so that the window and canvas are all ready
- # before this variable changes.
- set ::editmode($mytoplevel) $editable
-}
-
-# 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
-}
-
-proc pdtk_canvas_saveas {name initialfile initialdir} {
- if { ! [file isdirectory $initialdir]} {set initialdir $::env(HOME)}
- set filename [tk_getSaveFile -initialfile $initialfile -initialdir $initialdir \
- -defaultextension .pd -filetypes $::filetypes]
- if {$filename eq ""} return; # they clicked cancel
-
- set extension [file extension $filename]
- set oldfilename $filename
- set filename [regsub -- "$extension$" $filename [string tolower $extension]]
- if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} {
- # we need the file extention even on Mac OS X
- set filename $filename.pd
- }
- # test again after downcasing and maybe adding a ".pd" on the end
- if {$filename ne $oldfilename && [file exists $filename]} {
- set answer [tk_messageBox -type okcancel -icon question -default cancel\
- -message [_ "\"$filename\" already exists. Do you want to replace it?"]]
- if {$answer eq "cancel"} return; # they clicked cancel
- }
- set dirname [file dirname $filename]
- set basename [file tail $filename]
- pdsend "$name savetofile [enquote_path $basename] [enquote_path $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
-
-# 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 {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 {tkcanvas x y b} {
- set mytoplevel [winfo toplevel $tkcanvas]
- pdsend "$mytoplevel mouseup [$tkcanvas canvasx $x] [$tkcanvas canvasy $y] $b"
-}
-
-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 {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"
- }
- }
-}
-
-#------------------------------------------------------------------------------#
-# canvas popup menu
-
-# since there is one popup that is used for all canvas 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 same as the menubar in pd_menus.tcl but the opposite of the 'bind'
-# commands in pd_bindings.tcl
-proc ::pdtk_canvas::create_popup {} {
- if { ! [winfo exists .popup]} {
- # the popup menu for the canvas
- menu .popup -tearoff false
- .popup add command -label [_ "Properties"] \
- -command {::pdtk_canvas::done_popup $::focused_window 0}
- .popup add command -label [_ "Open"] \
- -command {::pdtk_canvas::done_popup $::focused_window 1}
- .popup add command -label [_ "Help"] \
- -command {::pdtk_canvas::done_popup $::focused_window 2}
- }
-}
-
-proc ::pdtk_canvas::done_popup {mytoplevel action} {
- pdsend "$mytoplevel done-popup $action $::popup_xcanvas $::popup_ycanvas"
-}
-
-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 {
- .popup entryconfigure [_ "Properties"] -state disabled
- }
- if {$hasopen} {
- .popup entryconfigure [_ "Open"] -state normal
- } else {
- .popup entryconfigure [_ "Open"] -state disabled
- }
- 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::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
deleted file mode 100644
index b23ae0b26a9983624d627fcbc6479d4f2122fcaa..0000000000000000000000000000000000000000
--- a/pd/tcl/pdtk_text.tcl
+++ /dev/null
@@ -1,56 +0,0 @@
-
-package provide pdtk_text 0.1
-
-# 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]
- 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
- $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"
- }
- }
-}
-
-# 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
deleted file mode 100644
index 4d7e282243b8aabf9dfa04092ddeacb12c7f19ba..0000000000000000000000000000000000000000
--- a/pd/tcl/pdtk_textwindow.tcl
+++ /dev/null
@@ -1,103 +0,0 @@
-# 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
deleted file mode 100644
index 7409bf3179a4962342f1e5b11bc5f3f9459fe06d..0000000000000000000000000000000000000000
--- a/pd/tcl/pdwindow.tcl
+++ /dev/null
@@ -1,400 +0,0 @@
-
-package provide pdwindow 0.1
-
-namespace eval ::pdwindow:: {
- 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::insert_log_line {object_id level message} {
- if {$object_id eq ""} {
- .pdwindow.text.internal insert end $message log$level
- } else {
- .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
- }
- # 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
- }
- # -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 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"]
- 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
-
- 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 \
- -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} \
- -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 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
deleted file mode 100644
index 55322377d0593517ba09661742c4ad3933074b40..0000000000000000000000000000000000000000
--- a/pd/tcl/pkgIndex.tcl
+++ /dev/null
@@ -1,37 +0,0 @@
-# Tcl package index file, version 1.1
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded apple_events 0.1 [list source [file join $dir apple_events.tcl]]
-package ifneeded pd_bindings 0.1 [list source [file join $dir pd_bindings.tcl]]
-package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]]
-package ifneeded 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/pkg_mkIndex.tcl b/pd/tcl/pkg_mkIndex.tcl
deleted file mode 100755
index 12f3ba479f0dae0ba03244271c84e1ee7e1ee131..0000000000000000000000000000000000000000
--- a/pd/tcl/pkg_mkIndex.tcl
+++ /dev/null
@@ -1,9 +0,0 @@
-#!/usr/bin/tclsh
-
-puts stdout "Watch out, this doesn't work on packages with namespace import"
-pkg_mkIndex -verbose -- [pwd] *.tcl *.[info sharedlibextension]
-
-## this currently needs to be added to pkg_mkIndex manually, ug
-#package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
-
-
diff --git a/pd/tcl/scrollbox.tcl b/pd/tcl/scrollbox.tcl
deleted file mode 100644
index b06670a0c8da6e707bc776dbdd6406a92a6f36da..0000000000000000000000000000000000000000
--- a/pd/tcl/scrollbox.tcl
+++ /dev/null
@@ -1,191 +0,0 @@
-######### 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
deleted file mode 100644
index d78622c665415dccdfce317d84e93fb814309e8c..0000000000000000000000000000000000000000
--- a/pd/tcl/scrollboxwindow.tcl
+++ /dev/null
@@ -1,94 +0,0 @@
-
-####### 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
deleted file mode 100644
index acee40c075096dd7cad6bdc9b940b2219d614efd..0000000000000000000000000000000000000000
--- a/pd/tcl/wheredoesthisgo.tcl
+++ /dev/null
@@ -1,111 +0,0 @@
-
-package provide wheredoesthisgo 0.1
-
-# a place to temporarily store things until they find a home or go away
-
-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 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 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"
-}
-
-# ------------------------------------------------------------------------------
-# 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]
-}
-
-# 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
-}
-
-# TODO enquote a filename to send it to pd, " isn't handled properly tho...
-proc enquote_path {message} {
- string map {"," "\\," ";" "\\;" " " "\\ "} $message
-}
-
-#enquote a string to send it to Pd. Blow off semi and comma; alias spaces
-#we also blow off "{", "}", "\" because they'll just cause bad trouble later.
-proc unspace_text {x} {
- set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
- if {$y eq ""} {set y "empty"}
- concat $y
-}
-
-# ------------------------------------------------------------------------------
-# watchdog functions
-
-proc pdtk_watchdog {} {
- pdsend "pd watchdog"
- after 2000 {pdtk_watchdog}
-}
-
-proc pdtk_ping {} {
- pdsend "pd ping"
-}