diff --git a/pd/src/dialog_array.tcl b/pd/src/dialog_array.tcl
deleted file mode 100644
index 564eb4ac1281356dc34a581d21cbedf6b26b648a..0000000000000000000000000000000000000000
--- a/pd/src/dialog_array.tcl
+++ /dev/null
@@ -1,456 +0,0 @@
-package provide dialog_array 0.1
-
-# todo: probably not a bad idea to unset these arrays
-
-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 "joc" check button
-array set joc_button {}
-# whether to hide the array name
-array set hidename_button {}
-# this stores the state of the "draw as" radio buttons
-array set drawas_button {}
-# border color for an element
-array set pd_array_outlinecolor {}
-# inner color for an element
-array set pd_array_fillcolor {}
-# 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 #########
-
-# hack: this should just use ::pd_bindings::dialog_bindings from 0.43 API
-proc ::dialog_array::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 ::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 #] }
-pdtk_post "drawas is $::drawas_button($mytoplevel)\n"
-pdtk_post "full bajitas is \
- [expr $::saveme_button($mytoplevel) + \
- (2 * $::drawas_button($mytoplevel)) + \
- (8 * $::hidename_button($mytoplevel)) + \
- (16 * $::joc_button($mytoplevel))] \
-\n"
-
-pdtk_post "mytop level is $mytoplevel\n"
- pd "[concat $mytoplevel arraydialog \
- $mofo \
- [$mytoplevel.size.entry get] \
- [expr $::saveme_button($mytoplevel) + \
- (2 * $::drawas_button($mytoplevel)) + \
- (8 * $::hidename_button($mytoplevel)) + \
- (16 * $::joc_button($mytoplevel))] \
- $::otherflag_button($mytoplevel) \
- $::pd_array_fillcolor($mytoplevel) \
- $::pd_array_outlinecolor($mytoplevel) \
- \; ]"
-}
-
-proc ::dialog_array::openlistview {mytoplevel} {
- pdsend "$mytoplevel arrayviewlistnew"
-}
-
-proc ::dialog_array::choosecolor {mytoplevel type} {
- set colorp [format "::pd_array_%scolor(%s)" $type $mytoplevel]
- if {[info exists $colorp]} {
- set initcolor [set $colorp]
- } else {
- set initcolor "black"}
- set tmp [tk_chooseColor -parent $mytoplevel -initialcolor $initcolor]
- if {$tmp eq ""} {return} else {set $colorp $tmp}
-}
-
-proc ::dialog_array::update_colorpreview {color widget args} {
- upvar #0 $color c
- $widget configure -background $c -activebackground $c
-}
-
-proc ::dialog_array::update_drawas {mytoplevel outlineframe filllabel args} {
- if {$::drawas_button($mytoplevel) == 3} {
- pack $outlineframe -before $mytoplevel.colors.o -side top -anchor w
- $filllabel configure -text "Outline color"
- } else {
- pack forget $outlineframe
- $filllabel configure -text "Trace color"
- }
-}
-
-proc ::dialog_array::cancel {mytoplevel} {
- pd "[concat $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 fillcolor outlinecolor} {
-if {[catch {
- if {[winfo exists $mytoplevel]} {
- wm deiconify $mytoplevel
- raise $mytoplevel
- } else {
- create_dialog $mytoplevel $newone
- }
-} fid]} {pdtk_post "error: $fid\n"}
- $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 ::hidename_button($mytoplevel) [expr ( $flags & 8 ) >> 3]
- set ::joc_button($mytoplevel) [expr ( $flags & 16) >> 4]
- set ::otherflag_button($mytoplevel) 0
- set ::pd_array_fillcolor($mytoplevel) $fillcolor
- set ::pd_array_outlinecolor($mytoplevel) $outlinecolor
-
-# 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
- # bad hack... this should just be ::pd_bindings::
- # from the 0.43 API
- ::dialog_array::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
-
- frame $mytoplevel.flags
- pack $mytoplevel.flags -side top -fill x -padx 20
- checkbutton $mytoplevel.flags.saveme -text [_ "Save contents"] \
- -variable ::saveme_button($mytoplevel)
- pack $mytoplevel.flags.saveme -side top -anchor w
- checkbutton $mytoplevel.flags.joc -text [_ "Jump on click"] \
- -variable ::joc_button($mytoplevel) -anchor w
- pack $mytoplevel.flags.joc -side top -anchor w
- checkbutton $mytoplevel.flags.hidename -text [_ "Hide array name"] \
- -variable ::hidename_button($mytoplevel) -anchor w
- pack $mytoplevel.flags.hidename -side top -anchor w
-
- labelframe $mytoplevel.drawas -text [_ "Draw as:"] -padx 20 -borderwidth 1
- pack $mytoplevel.drawas -side top -fill x
- radiobutton $mytoplevel.drawas.points -value 1 \
- -variable ::drawas_button($mytoplevel) -text [_ "Points"]
- radiobutton $mytoplevel.drawas.polygon -value 0 \
- -variable ::drawas_button($mytoplevel) -text [_ "Polygon"]
- radiobutton $mytoplevel.drawas.bezier -value 2 \
- -variable ::drawas_button($mytoplevel) -text [_ "Bezier curve"]
- radiobutton $mytoplevel.drawas.bargraph -value 3 \
- -variable ::drawas_button($mytoplevel) -text [_ "Bargraph"]
- pack $mytoplevel.drawas.points -side top -anchor w
- pack $mytoplevel.drawas.polygon -side top -anchor w
- pack $mytoplevel.drawas.bezier -side top -anchor w
- pack $mytoplevel.drawas.bargraph -side top -anchor w
- trace add variable ::drawas_button($mytoplevel) write \
- "::dialog_array::update_drawas $mytoplevel $mytoplevel.colors.f \
- $mytoplevel.colors.o.outlinecolor"
-
- set fillp ::pd_array_fillcolor($mytoplevel)
- set outlinep ::pd_array_outlinecolor($mytoplevel)
- labelframe $mytoplevel.colors -text [_ "Colors:"] -padx 20 -pady 5 \
- -borderwidth 1
- pack $mytoplevel.colors -side top -fill both
- frame $mytoplevel.colors.f
- frame $mytoplevel.colors.o
- pack $mytoplevel.colors.f -side top -anchor w
- pack $mytoplevel.colors.o -side top -anchor w
- set fillpreview $mytoplevel.colors.f.preview
- set flabel [label $mytoplevel.colors.f.fillcolor -text [_ "Fill color"]]
- set olabel \
- [label $mytoplevel.colors.o.outlinecolor -text [_ "Outline color"]]
- bind $flabel <Enter> "$flabel configure -foreground blue"
- bind $flabel <Leave> "$flabel configure -foreground black"
- bind $flabel <1> "::dialog_array::choosecolor $mytoplevel fill"
- bind $olabel <Enter> "$olabel configure -foreground blue"
- bind $olabel <Leave> "$olabel configure -foreground black"
- bind $olabel <1> "::dialog_array::choosecolor $mytoplevel outline"
- button $fillpreview -relief raised -padx 7 -pady 0 \
- -command "::dialog_array::choosecolor $mytoplevel fill"
- set outlinepreview $mytoplevel.colors.o.preview
- button $outlinepreview -relief raised -padx 7 -pady 0 \
- -command \
- "::dialog_array::choosecolor $mytoplevel outline"
- #automagically update the preview buttons when the variables are changed
- trace add variable $fillp write \
- "::dialog_array::update_colorpreview $fillp $fillpreview"
- trace add variable $outlinep write \
- "::dialog_array::update_colorpreview $outlinep $outlinepreview"
- pack $mytoplevel.colors.f.fillcolor -side right -anchor w
- pack $mytoplevel.colors.f.preview -side left -anchor e -padx 3
- pack $mytoplevel.colors.o.outlinecolor -side right -anchor w
- pack $mytoplevel.colors.o.preview -side left -anchor e -padx 3
-
- 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/src/dialog_audio.tcl b/pd/src/dialog_audio.tcl
deleted file mode 100644
index 94f0ad5fce800d42aec7d3a7eda58bed3cae24fd..0000000000000000000000000000000000000000
--- a/pd/src/dialog_audio.tcl
+++ /dev/null
@@ -1,353 +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.
-# * make sure combobox is setting the device number
-# * get focus order to do right
-# * add "Close" button to prefs dialog
-
-####################### 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
-
- # Hackety hack! Rather than make this audio dialog code sane,
- # which would be a larger project, I'm just making the user interface
- # look more friendly. The global "enable" variables were used
- # for checkbuttons; I simplified the interface by removing them and
- # adding a "None" option to the device list. This means I have
- # to parse the dev names for the string "None" and set the "enable"
- # variables accordingly. I also assume "None" is the last value in the
- # list.
-
- foreach type {in out} {
- foreach i {1 2 3 4} {
- if {[set audio_${type}dev${i}] == \
- [llength [set ::audio_${type}devlist]] ||
- [set audio_${type}chan${i}] <= 0} {
- set audio_${type}dev${i} 0
- set audio_${type}enable${i} 0
- set audio_${type}chan${i} 0
- } else {
- set audio_${type}enable${i} 1
- }
- }
- }
-
- pd [concat 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 \
- \;]
-
- # Pd always makes devices contiguous-- for example, if you only set
- # device 1 and device 3 it will change device 3 to device 2.
- # So we look for non-contiguous devices and request an update
- # on connect so that the user doesn't see incorrect information
- # in the GUI. This rebuilds part of the dialog window which causes
- # a slight flicker-- otherwise I'd just do this everytime:
- # pdsend "pd audio-properties $::audio_longform
- foreach type {in out} {
- set empty_dev 0
- set aliased_dev 0
- foreach i {1 2 3 4} {
- set enabled [set audio_${type}enable$i]
- if {$empty_dev && $enabled} {
- set aliased_dev 1
- break
- } elseif {!$enabled} {incr empty_dev}
- }
- if {$aliased_dev} {
- pd [concat pd audio-properties $::audio_longform \;]
- break
- }
- }
- pd [concat pd save-preferences \;]
-}
-
-proc ::dialog_audio::cancel {mytoplevel} {
-# pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_audio::ok {mytoplevel} {
- ::dialog_audio::apply $mytoplevel
- ::dialog_audio::cancel $mytoplevel
-}
-
-proc ::dialog_audio::setapi {var - op} {
- if {$op ne "write"} {return}
- set name [set $var]
- set index [lsearch -exact -index 0 $::pd_apilist $name]
- set ::pd_whichapi [lindex $::pd_apilist $index 1]
- pd [concat pd audio-setapi $::pd_whichapi \;]
-}
-
-proc ::dialog_audio::setlongform {widget} {
- set state [set ::$widget]
- if {$state == 0} {
- # back to single devs
- set extra_devs 0
- foreach type {in out} {
- foreach i {2 3 4} {
- if { [set ::audio_${type}chan$i] > 0 &&
- [set ::audio_${type}enable$i] > 0 } {
- incr extra_devs
- }
- }
- }
- if {$extra_devs} {
- set devices devices
- if {$extra_devs == 1} {set devices device}
- set continue [tk_messageBox -type yesno -message \
- [_ "This will disconnect $extra_devs $devices. Continue?"] \
- -default "no" -parent [winfo parent $widget] -icon question]
- if {$continue eq "yes"} {
- foreach type {in out} {
- foreach i {2 3 4} {
- set ::audio_${type}chan$i 0
- set ::audio_${type}enable$i 0
- }
- }
- ::dialog_audio::apply [winfo parent $widget]
- }
- }
- }
- pd [concat pd audio-properties $state \;]
-}
-
-# 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 {id \
- 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_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 ]
-
- # "None" is added as the last value in the dropdown menu, so it's
- # equivalent to the length of the devlist
- set nonein [llength $audio_indevlist]
- set noneout [llength $audio_outdevlist]
-
- set audio_indev1 [expr ( $audio_inenable1 ? $indev1 : $nonein )]
- set audio_indev2 [expr ( $audio_inenable2 ? $indev2 : $nonein )]
- set audio_indev3 [expr ( $audio_inenable3 ? $indev3 : $nonein )]
- set audio_indev4 [expr ( $audio_inenable4 ? $indev4 : $nonein )]
-
- 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_outdev1 [expr ( $audio_outenable1 ? $outdev1 : $noneout )]
- set audio_outdev2 [expr ( $audio_outenable2 ? $outdev2 : $noneout )]
- set audio_outdev3 [expr ( $audio_outenable3 ? $outdev3 : $noneout )]
- set audio_outdev4 [expr ( $audio_outenable4 ? $outdev4 : $noneout )]
-
- set audio_sr $sr
- set audio_advance $advance
- set audio_callback $callback
- set audio_blocksize $blocksize
- set audio_longform $longform
-
- set mytoplevel .prefs.nb.audio
- set apifr $mytoplevel.api
- if {![winfo exists $apifr]} {
-
- # Audio API
- ttk::labelframe $mytoplevel.api -text [_ "Audio API"] \
- -style Prefs.TLabelframe
- pack $apifr -side top -padx 1 -pady 1 -fill x
- set api_names {}
- set ::audio_apiname {};
- foreach api $::pd_apilist {lappend api_names [lindex $api 0]}
- set api_i [lsearch -exact -index 1 $::pd_apilist $::pd_whichapi]
- set ::audio_apiname [lindex $::pd_apilist $api_i 0]
- ::dialog_prefs::dropdown $apifr.apilist ::audio_apiname $api_names
- trace add variable ::audio_apiname write ::dialog_audio::setapi
- grid $apifr.apilist -sticky e -column 0 -row 0 -padx 3 -pady 10
- ttk::checkbutton $apifr.longbutton -text "Use multiple devices" \
- -command "::dialog_audio::setlongform $apifr.longbutton"
- grid $apifr.longbutton -sticky w -column 1 -row 0 -padx 3 -pady 10
- grid columnconfigure $apifr {0 1} -weight 1
- }
- # disable longbutton if hardware doesn't support multi devices
- set state normal
- if {![expr [llength $audio_indevlist] > 1 && \
- $multi>1 && [llength $audio_outdevlist] > 1]} {
- set state disabled
- }
- $apifr.longbutton configure -state $state
-
- # frame to encapsulate api-specific settings and devices,
- # as well as the "Connect" button
- set afr $mytoplevel.audio
-
- destroy $afr
- ttk::frame $afr
- pack $afr -side top -fill x
-
- # todo: put padding with style settings in dialog_prefs.tcl
- set padx 1
-
- # sample rate and advance
- set sfr [ttk::labelframe $afr.settings -text [_ "Settings"] \
- -style Prefs.TLabelframe -padding 5 ]
- pack $sfr -side top -fill x -padx 3 -pady 10
- ttk::label $sfr.l1 -text [_ "Sample rate"]
- ttk::label $sfr.l2 -text [_ "Block size"]
- ::dialog_prefs::dropdown $sfr.x2 \
- ::audio_blocksize {64 128 256 512 1024 2048}
- ttk::entry $sfr.x1 -textvariable audio_sr -width 7
- ttk::label $sfr.l3 -text [_ "Delay (ms)"]
- ttk::entry $sfr.x3 -textvariable audio_advance -width 7
- grid $sfr.l1 -row 0 -sticky e -padx $padx
- grid $sfr.x1 -row 0 -column 1 -sticky w -padx $padx
- grid $sfr.l2 -row 0 -column 2 -sticky e -padx $padx
- grid $sfr.x2 -row 0 -column 3 -sticky w -padx $padx
- grid $sfr.l3 -row 1 -column 0 -sticky e -padx $padx
- grid $sfr.x3 -row 1 -column 1 -sticky w -padx $padx
- if {$audio_callback >= 0} {
- ttk::label $sfr.l4 -text [_ "Use callbacks"] -anchor e
- ttk::checkbutton $sfr.x4 -variable audio_callback
- grid $sfr.l4 -column 2 -row 1 -sticky e -padx $padx
- grid $sfr.x4 -column 3 -row 1 -sticky w -padx $padx
- }
- grid columnconfigure $sfr {0 2} -weight 1
- grid columnconfigure $sfr {1 3} -weight 2
-
- # Devices
- set devfr [ttk::labelframe $afr.devs -text [_ "Devices"] \
- -style Prefs.TLabelframe]
- pack $devfr -side top -fill x -padx 3 -pady 10
- set j 2
- # todo: change in out to input output and make translatable strings
- foreach {type name} [list in [_ "Input"] out [_ "Output"]] {
- set domulti [expr $longform && $multi > 1 && \
- [llength [set "audio_${type}devlist"]] > 1]
- if {$domulti} {
- ttk::label $devfr.$type \
- -text [concat $name [_ "Devices"]]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- } else {
- if {$type eq "in"} {
- ttk::label $devfr.$type \
- -text [_ "Device Name"]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -columnspan 2 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- }
- }
- # Note: it'd be fairly easy to change the GUI to accommodate
- # more than four devices, but Pd only takes and receives at most
- # four devices, so the entire backend would have to change in order
- # to do that
- for {set i 0} {$i < 4} \
- {incr i} {
- set devno [expr $i + 1]
- set row "$devfr.${type}$devno"
- if {$domulti} {
- set ctext "$devno."
- } else {
- set ctext $name
- }
- ttk::label ${row}x0 -text $ctext -anchor w
- set ::audio_${type}dev${devno}label {}
- ::dialog_prefs::dropdown_by_index ${row}x1 \
- "::audio_${type}dev$devno" \
- [concat [set audio_${type}devlist] None] \
- "::audio_${type}dev${devno}label"
- if {[set audio_${type}enable$devno] > 0} {
- ::dialog_prefs::dropdown_set ${row}x1 [lindex [set audio_${type}devlist] [set audio_${type}dev$devno]]
- } else {
- ::dialog_prefs::dropdown_set ${row}x1 "None"
- set audio_${type} [llength [set audio_${type}devlist]]
- }
- ttk::entry ${row}x2 -textvariable "audio_${type}chan$devno" -width 4
- grid ${row}x0 -row $j -column 0 -sticky e -padx $padx
- grid ${row}x1 -row $j -column 1 -columnspan 2 -sticky ew -padx $padx
- grid ${row}x2 -row $j -column 3 -padx $padx
- grid columnconfigure $afr.devs {1 2 3} -weight 2
- grid columnconfigure $afr.devs 0 -weight 1
- incr j
- if {![expr $longform && $multi > 1 && \
- [llength [set "audio_${type}devlist"]] > 1]} {
- break
- }
- }
- }
- grid rowconfigure $devfr all -pad 3
-
- # Connect button
- ttk::frame $afr.buttonframe
- pack $afr.buttonframe
- pack $afr.buttonframe -side bottom
- ttk::button $afr.buttonframe.apply -text [_ "Apply Audio Settings"]\
- -command "::dialog_audio::apply $mytoplevel"
- pack $afr.buttonframe.apply -side left -expand 1 -fill x \
- -padx 15
-
-# $sfr.x1 select from 0
-# $sfr.x1 select adjust end
- focus $apifr.apilist
-}
diff --git a/pd/src/dialog_gui.tcl b/pd/src/dialog_gui.tcl
deleted file mode 100644
index e55180b941035a42a018f9c2e36bb8a078f7b2f4..0000000000000000000000000000000000000000
--- a/pd/src/dialog_gui.tcl
+++ /dev/null
@@ -1,329 +0,0 @@
-package provide dialog_gui 0.1
-package require dialog_prefs
-package require pd_guiprefs
-
-namespace import ::pd_guiprefs::write_guipreset
-
-namespace eval ::dialog_gui:: {
- namespace export create_gui_dialog
-}
-
-####################### gui dialog ##################3
-
-proc ::dialog_gui::apply {mytoplevel} {
- # nothing to do
-}
-
-proc ::dialog_gui::cancel {mytoplevel} {
-# pdsend "$mytoplevel cancel"
-}
-
-proc ::dialog_gui::ok {mytoplevel} {
- ::dialog_gui::apply $mytoplevel
- ::dialog_gui::cancel $mytoplevel
-}
-
-proc ::dialog_gui::setswatch {b swatch} {
- $b configure -image $swatch
-}
-
-# this is triggered whenever the ::gui_preset
-# variable is written to
-proc ::dialog_gui::set_gui_preset {args} {
- set choice $::gui_preset
- ::pd_guiprefs::write_guipreset
- switch $choice {
- Vanilla {
- set ::pd_colors(atom_box) white
- set ::pd_colors(atom_box_border) black
- set ::pd_colors(canvas_color) white
- set ::pd_colors(canvas_cursor) black
- set ::pd_colors(text) black
- set ::pd_colors(text_in_console) black
- set ::pd_colors(box) white
- set ::pd_colors(box_border) black
- set ::pd_colors(msg) white
- set ::pd_colors(msg_border) black
- set ::pd_colors(iemgui_border) black
- set ::pd_colors(control_cord) black
- set ::pd_colors(control_nlet) white
- set ::pd_colors(iemgui_nlet) black
- set ::pd_colors(signal_cord) black
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(control_nlet) white
- set ::pd_colors(xlet_hover) grey
- set ::pd_colors(link) blue
- set ::pd_colors(selection) blue
- set ::pd_colors(selection_rectangle) black
- set ::pd_colors(highlighted_text) black
- set ::pd_colors(highlighted_text_bg) #c3c3c3
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) white
- set ::pd_colors(graph_border) black
- set ::pd_colors(graph) white
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) "#ffffff"
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- Inverted {
- set ::pd_colors(atom_box) black
- set ::pd_colors(atom_box_border) white
- set ::pd_colors(canvas_color) black
- set ::pd_colors(canvas_cursor) white
- set ::pd_colors(text) white
- set ::pd_colors(text_in_console) white
- set ::pd_colors(box) black
- set ::pd_colors(box_border) white
- set ::pd_colors(msg) black
- set ::pd_colors(msg_border) white
- set ::pd_colors(iemgui_border) white
- set ::pd_colors(control_cord) white
- set ::pd_colors(control_nlet) white
- set ::pd_colors(iemgui_nlet) white
- set ::pd_colors(signal_cord) white
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(control_nlet) white
- set ::pd_colors(xlet_hover) grey
- set ::pd_colors(link) yellow
- set ::pd_colors(selection) yellow
- set ::pd_colors(selection_rectangle) white
- set ::pd_colors(highlighted_text) white
- set ::pd_colors(highlighted_text_bg) #3c3c3c
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) black
- set ::pd_colors(graph_border) white
- set ::pd_colors(graph) gray
- set ::pd_colors(magic_glass_bg) white
- set ::pd_colors(magic_glass_bd) white
- set ::pd_colors(magic_glass_text) "#000000"
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- L2Ork {
- set ::pd_colors(atom_box) "#eee"
- set ::pd_colors(atom_box_border) "#ccc"
- set ::pd_colors(canvas_color) white
- set ::pd_colors(canvas_cursor) black
- set ::pd_colors(text) black
- set ::pd_colors(text_in_console) grey40
- set ::pd_colors(box) "#f6f8f8"
- set ::pd_colors(box_border) "#ccc"
- set ::pd_colors(msg) #f8f8f6
- set ::pd_colors(msg_border) "#ccc"
- set ::pd_colors(iemgui_border) "#000000"
- set ::pd_colors(iemgui_nlet) "#000000"
- set ::pd_colors(control_cord) "#565"
- set ::pd_colors(control_nlet) white
- set ::pd_colors(signal_cord) #808095
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(xlet_hover) grey
- set ::pd_colors(link) "#eb5f28"
- set ::pd_colors(selection) #e87216
- set ::pd_colors(selection_rectangle) #e87216
- set ::pd_colors(highlighted_text) black
- set ::pd_colors(highlighted_text_bg) #c3c3c3
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) "#ffdddd"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) white
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- L2Ork_Inverted {
- set ::pd_colors(atom_box) black
- set ::pd_colors(atom_box_border) white
- set ::pd_colors(canvas_color) black
- set ::pd_colors(canvas_cursor) white
- set ::pd_colors(text) white
- set ::pd_colors(text_in_console) #999999
- set ::pd_colors(box) #090707
- set ::pd_colors(box_border) #3e3e3e
- set ::pd_colors(msg) #090707
- set ::pd_colors(msg_border) #3e3e3e
- set ::pd_colors(iemgui_border) white
- set ::pd_colors(iemgui_nlet) white
- set ::pd_colors(control_cord) white
- set ::pd_colors(control_nlet) #a294a2
- set ::pd_colors(signal_cord) #7d7d68
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(xlet_hover) white
- set ::pd_colors(link) blue
- set ::pd_colors(selection) #ffff00
- set ::pd_colors(selection_rectangle) white
- set ::pd_colors(highlighted_text) white
- set ::pd_colors(highlighted_text_bg) #3c3c3c
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) "#002222"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) gray
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- Extended {
- set ::pd_colors(atom_box) #e0e0e0
- set ::pd_colors(atom_box_border) #c1c1c1
- set ::pd_colors(canvas_color) white
- set ::pd_colors(canvas_cursor) black
- set ::pd_colors(text) black
- set ::pd_colors(text_in_console) black
- set ::pd_colors(box) #f6f8f8
- set ::pd_colors(box_border) #c1c1c1
- set ::pd_colors(msg) #f6f8f8
- set ::pd_colors(msg_border) #c1c1c1
- set ::pd_colors(iemgui_border) black
- set ::pd_colors(iemgui_nlet) black
- set ::pd_colors(control_cord) black
- set ::pd_colors(control_nlet) white
- set ::pd_colors(signal_cord) #828297
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(control_nlet) #536253
- set ::pd_colors(xlet_hover) grey
- set ::pd_colors(link) blue
- set ::pd_colors(selection) blue
- set ::pd_colors(selection_rectangle) black
- set ::pd_colors(highlighted_text) black
- set ::pd_colors(highlighted_text_bg) #c3c3c3
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) "#f7f7f7"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) white
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- C64 {
- set ::pd_colors(atom_box) #3e32a2
- set ::pd_colors(atom_box_border) #7569d7
- set ::pd_colors(canvas_color) #3e32a2
- set ::pd_colors(canvas_cursor) white
- set ::pd_colors(text) #a49aea
- set ::pd_colors(text_in_console) #a49aea
- set ::pd_colors(box) #3e32a2
- set ::pd_colors(box_border) #7569d7
- set ::pd_colors(msg) #3e32a2
- set ::pd_colors(msg_border) #7569d7
- set ::pd_colors(iemgui_border) #7569d7
- set ::pd_colors(iemgui_nlet) #7569d7
- set ::pd_colors(control_cord) #7569d7
- set ::pd_colors(control_nlet) white
- set ::pd_colors(signal_cord) #7569d7
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(control_nlet) #7c71da
- set ::pd_colors(xlet_hover) grey
- set ::pd_colors(link) #e87216
- set ::pd_colors(selection) #cc9933
- set ::pd_colors(selection_rectangle) #7c71da
- set ::pd_colors(highlighted_text) #3e32a2
- set ::pd_colors(highlighted_text_bg) #a49aea
- set ::pd_colors(dash_outline) "#ff9933"
- set ::pd_colors(dash_fill) "#3e32a2"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) "#3e32a2"
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- Strongbad {
- set ::pd_colors(atom_box) black
- set ::pd_colors(atom_box_border) #0b560b
- set ::pd_colors(canvas_color) black
- set ::pd_colors(canvas_cursor) white
- set ::pd_colors(text) #4bd046
- set ::pd_colors(text_in_console) #4bd046
- set ::pd_colors(box) black
- set ::pd_colors(box_border) #0b560b
- set ::pd_colors(msg) black
- set ::pd_colors(msg_border) #0b560b
- set ::pd_colors(iemgui_border) #0b560b
- set ::pd_colors(iemgui_nlet) #0b560b
- set ::pd_colors(control_cord) #53b83b
- set ::pd_colors(control_nlet) #53b83b
- set ::pd_colors(signal_cord) #53b83b
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(xlet_hover) white
- set ::pd_colors(link) blue
- set ::pd_colors(selection) green
- set ::pd_colors(selection_rectangle) #53b83b
- set ::pd_colors(highlighted_text) black
- set ::pd_colors(highlighted_text_bg) #4bd046
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) "#f7f7f7"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) "#53b83b"
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- Subdued {
- set ::pd_colors(atom_box) #9fc79f
- set ::pd_colors(atom_box_border) #b1d3b1
- set ::pd_colors(canvas_color) #c0dcc0
- set ::pd_colors(canvas_cursor) black
- set ::pd_colors(text) black
- set ::pd_colors(text_in_console) black
- set ::pd_colors(box) #c0dcc0
- set ::pd_colors(box_border) #666666
- set ::pd_colors(msg) #c0dcc0
- set ::pd_colors(msg_border) #666666
- set ::pd_colors(iemgui_border) #666666
- set ::pd_colors(iemgui_nlet) #666666
- set ::pd_colors(control_cord) #333333
- set ::pd_colors(control_nlet) #333333
- set ::pd_colors(signal_cord) #666666
- set ::pd_colors(signal_nlet) $::pd_colors(signal_cord)
- set ::pd_colors(xlet_hover) white
- set ::pd_colors(link) blue
- set ::pd_colors(selection) blue
- set ::pd_colors(selection_rectangle) #333333
- set ::pd_colors(highlighted_text) black
- set ::pd_colors(highlighted_text_bg) #c3c3c3
- set ::pd_colors(dash_outline) "#f00"
- set ::pd_colors(dash_fill) "#f7f7f7"
- set ::pd_colors(graph_border) "#777"
- set ::pd_colors(graph) "#9fc79f"
- set ::pd_colors(magic_glass_bg) black
- set ::pd_colors(magic_glass_bd) black
- set ::pd_colors(magic_glass_text) white
- set ::pd_colors(magic_glass_flash) "#e87216"
- }
- Custom {
- # empty one if we have any custom settings
- }
- }
-}
-
-proc ::dialog_gui::create_gui_dialog {mytoplevel} {
- if [winfo exists $mytoplevel.colors] then return
- set fr [ttk::frame $mytoplevel.colors]
- set p [ttk::frame $fr.presets]
- ttk::label $p.presetlabel -text "Color Preset"
-# ttk::combobox $fr.presets -state readonly -values {Inverted L2Ork Foo}
-# todo: set presets in _one_ place
- ::dialog_prefs::dropdown $p.presets ::gui_preset {Vanilla Inverted L2Ork L2Ork_Inverted Extended C64 Strongbad Subdued Custom}
- pack $fr -side top
- grid $p -column 0 -columnspan 3 -row 0 -sticky w -pady 21
- pack $p.presetlabel -side left -padx 7
- pack $p.presets -side left
- set clen [expr {[llength [array names ::pd_colors]] / 2}]
- set i 0
- foreach name [lsort [array names ::pd_colors]] {
- # hack to exclude widths
- if {[regexp {.*width} $name]} {continue}
- set label [string map {_ " "} $name]
- set label [string toupper $label 0 0]
- ::dialog_prefs::swatchbutton $fr.$name ::pd_colors($name)
- ::dialog_prefs::set_swatchbutton $fr.$name \
- ::pd_colors($name)
- ttk::label $fr.${name}label -text "$label"
- grid $fr.${name} -column [expr $i/$clen * 2] -row [expr $i%$clen+1] -sticky e
- grid $fr.${name}label -column [expr $i/$clen * 2 + 1] -row [expr $i%$clen+1] -sticky w -padx 7 -pady 3
- incr i
- }
-}
diff --git a/pd/src/dialog_midi.tcl b/pd/src/dialog_midi.tcl
deleted file mode 100644
index bc8ec9155ac4a15f9973dc46e4ff82aabf8639fc..0000000000000000000000000000000000000000
--- a/pd/src/dialog_midi.tcl
+++ /dev/null
@@ -1,324 +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
-}
-
-proc ::dialog_midi::setapi {var - op} {
- if {$op ne "write"} {return}
- set name [set $var]
- set index [lsearch -exact -index 0 $::pd_midiapilist $name]
- set ::pd_whichmidiapi [lindex $::pd_midiapilist $index 1]
- pdsend "pd midi-setapi $::pd_whichmidiapi"
-}
-
-proc ::dialog_midi::setlongform {widget} {
- set state [set ::$widget]
- if {$state == 0} {
- # back to single devs
- set extra_devs 0
- foreach type {in out} {
- foreach i {2 3 4} {
- if { [set ::midi_${type}chan$i] > 0 &&
- [set ::midi_${type}enable$i] > 0 } {
- incr extra_devs
- }
- }
- }
- if {$extra_devs} {
- set devices devices
- if {$extra_devs == 1} {set devices device}
- set continue [tk_messageBox -type yesno -message \
- [_ "This will disconnect $extra_devs $devices. Continue?"] \
- -default "no" -parent [winfo parent $widget] -icon question]
- if {$continue eq "yes"} {
- foreach type {in out} {
- foreach i {2 3 4} {
- set ::midi_${type}chan$i 0
- set ::midi_${type}enable$i 0
- }
- }
- ::dialog_midi::apply [winfo parent $widget]
- }
- }
- }
- pdsend "pd midi-properties $state"
-}
-
-proc ::dialog_midi::create_api_frame {mytoplevel apifr midi_indevlist \
- midi_outdevlist longform} {
- if {![winfo exists $apifr]} {
-
- # MIDI API
- ttk::labelframe $mytoplevel.api -text [_ "Midi API"] \
- -style Prefs.TLabelframe
- pack $apifr -side top -padx 1 -pady 1 -fill x
- if {$::pd_midiapilist eq ""} {
- ttk::label $apifr.label -text "System Midi"
- grid $apifr.label -sticky e -column 0 -row 0 -padx 3 -pady 10
- } else {
- set api_names {}
- foreach api $::pd_midiapilist {lappend api_names [lindex $api 0]}
- set api_i [lsearch -exact -index 1 $::pd_midiapilist \
- $::pd_whichmidiapi]
- set ::midi_apiname [lindex $::pd_midiapilist $api_i 0]
- ::dialog_prefs::dropdown $apifr.apilist ::midi_apiname $api_names
- trace add variable ::midi_apiname write ::dialog_midi::setapi
- grid $apifr.apilist -sticky e -column 0 -row 0 -padx 3 -pady 10
- }
- ttk::checkbutton $apifr.longbutton -text "Use multiple devices" \
- -command "::dialog_midi::setlongform $apifr.longbutton"
- grid $apifr.longbutton -sticky w -column 1 -row 0 -padx 3 -pady 10
- grid columnconfigure $apifr {0 1} -weight 1
- }
- # disable longbutton if hardware doesn't support multi devices
- set state normal
- if {![expr [llength $midi_indevlist] > 1 && \
- [llength $midi_outdevlist] > 1]} {
- set state disabled
- }
- $apifr.longbutton configure -state disabled
-}
-
-# 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
- global midi_longform
- 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]
- set midi_longform $longform
- set mytoplevel .prefs.nb.midi
- set apifr $mytoplevel.api
- # not sure why it's ...midi.midi... should probably
- # fix that...
- ::dialog_midi::create_api_frame $mytoplevel $apifr $midi_indevlist \
- $midi_outdevlist $longform
- destroy $mytoplevel.midi
- ttk::frame $mytoplevel.midi
- pack $mytoplevel.midi -side top -fill x
-
- # todo: put padding with style settings in dialog_prefs.tcl
- set padx 1
-
- # Devices
- set devfr [ttk::labelframe $mytoplevel.midi.devs -text [_ "Devices"] \
- -style Prefs.TLabelframe -padding 5]
- pack $devfr -side top -fill x -padx 3 -pady 10
-
- set j 2
- # todo: change in out to input output and make translatable strings
- foreach {type name} [list in [_ "Input"] out [_ "Output"]] {
- set domulti [expr $longform && \
- [llength [set "midi_${type}devlist"]] > 1]
- if {$domulti} {
- ttk::label $devfr.$type \
- -text [concat $name [_ "Devices"]]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- } else {
- if {$type eq "in"} {
- ttk::label $devfr.$type \
- -text [_ "Device Name"]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -columnspan 2 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- }
- }
- # Note: it'd be fairly easy to change the GUI to accommodate
- # more than four devices, but Pd only takes and receives at most
- # four devices, so the entire backend would have to change in order
- # to do that
- for {set i 0} {$i < 4} {incr i} {
- set devno [expr $i + 1]
- set row "$devfr.${type}$devno"
- if {$domulti} {
- set ctext "$devno."
- } else {
- set ctext $name
- }
- ttk::label ${row}x0 -text $ctext -anchor w
- set ::midi_${type}dev${devno}label {}
- ::dialog_prefs::dropdown_by_index ${row}x1 \
- "::midi_${type}dev$devno" \
- [set "midi_${type}devlist"] \
- "::midi_${type}dev${devno}label"
- ttk::entry ${row}x2 -textvariable "midi_${type}chan$devno" -width 4
- grid ${row}x0 -row $j -column 0 -sticky e -padx $padx
- grid ${row}x1 -row $j -column 1 -columnspan 2 -sticky ew -padx $padx
- grid ${row}x2 -row $j -column 3 -padx $padx
- grid columnconfigure $mytoplevel.midi.devs {1 2 3} -weight 2
- grid columnconfigure $mytoplevel.midi.devs 0 -weight 1
- incr j
- if {![expr $longform && \
- [llength [set "midi_${type}devlist"]] > 1]} {
- break
- }
- }
- }
- grid rowconfigure $devfr all -pad 3
-
- # Connect button
- ttk::frame $mytoplevel.midi.buttonframe
- pack $mytoplevel.midi.buttonframe
- pack $mytoplevel.midi.buttonframe -side bottom
- ttk::button $mytoplevel.midi.buttonframe.apply \
- -text [_ "Apply MIDI Settings"] \
- -command "::dialog_midi::apply $mytoplevel"
- pack $mytoplevel.midi.buttonframe.apply -side left -expand 1 -fill x \
- -padx 15
-}
-
-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]
- set mytoplevel .prefs.nb.midi
- set apifr $mytoplevel.api
- # not sure why it's ...midi.midi... should probably
- # fix that...
- ::dialog_midi::create_api_frame $mytoplevel $apifr $midi_indevlist \
- $midi_outdevlist $longform
- destroy $mytoplevel.midi
- ttk::frame $mytoplevel.midi
- pack $mytoplevel.midi -side top -fill x
-
- # todo: put padding with style settings in dialog_prefs.tcl
- set padx 1
-
- # Devices
- set devfr [ttk::labelframe $mytoplevel.midi.devs -text [_ "Devices"] \
- -style Prefs.TLabelframe -padding 5]
- pack $devfr -side top -fill x -padx 3 -pady 10
-
- if {$alsa == 0} {
- set j 2
- foreach {type name} [list in [_ "Input"] out [_ "Output"]] {
- set domulti [expr $longform && \
- [llength [set "midi_${type}devlist"]] > 1]
- if {$domulti} {
- ttk::label $devfr.$type \
- -text [concat $name [_ "Devices"]]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- } else {
- if {$type eq "in"} {
- ttk::label $devfr.$type \
- -text [_ "Device Name"]
- ttk::label $devfr.${type}ch -text [_ "Channels"]
- grid $devfr.$type -row $j -column 1 -columnspan 2 -padx $padx
- grid $devfr.${type}ch -row $j -column 3 -padx $padx
- incr j
- }
- }
- for {set i 0} {$i < [llength [set "midi_${type}devlist"]]} \
- {incr i} {
- set devno [expr $i + 1]
- set row "$devfr.${type}$devno"
- if {$domulti} {
- set ctext "$devno."
- } else {
- set ctext $name
- }
- ttk::label ${row}x0 -text $ctext -anchor w
- set ::midi_${type}dev${devno}label {}
- ::dialog_prefs::dropdown_by_index ${row}x1 \
- "midi_${type}dev$devno" \
- [set "midi_${type}devlist"] \
- "::midi_${type}dev${devno}label"
- ttk::entry ${row}x2 -textvariable "midi_${type}chan$devno" -width 4
- grid ${row}x0 -row $j -column 0 -sticky e -padx $padx
- grid ${row}x1 -row $j -column 1 -columnspan 2 -sticky ew -padx $padx
- grid ${row}x2 -row $j -column 3 -padx $padx
- grid columnconfigure $mytoplevel.midi.devs {1 2 3} -weight 2
- grid columnconfigure $mytoplevel.midi.devs 0 -weight 1
- incr j
- if {![expr $longform && \
- [llength [set "midi_${type}devlist"]] > 1]} {
- break
- }
- }
- }
- grid rowconfigure $devfr all -pad 3
- } else {
- ttk::label $devfr.l1 -text [_ "In Ports:"]
- entry $devfr.x1 -textvariable midi_alsain -width 4
- pack $devfr.l1 $devfr.x1 -side left
- ttk::label $devfr.l2 -text [_ "Out Ports:"]
- entry $devfr.x2 -textvariable midi_alsaout -width 4
- pack $devfr.l2 $devfr.x2 -side left
- }
-
- # Connect button
- ttk::frame $mytoplevel.midi.buttonframe
- pack $mytoplevel.midi.buttonframe
- pack $mytoplevel.midi.buttonframe -side bottom
- ttk::button $mytoplevel.midi.buttonframe.apply -text [_ "Connect"]\
- -command "::dialog_midi::apply $mytoplevel"
- pack $mytoplevel.midi.buttonframe.apply -side left -expand 1 -fill x \
- -padx 15
-}
diff --git a/pd/src/dialog_prefs.tcl b/pd/src/dialog_prefs.tcl
deleted file mode 100644
index 57a04454b46e6904d0e42db9cb55cdf1caf49cc5..0000000000000000000000000000000000000000
--- a/pd/src/dialog_prefs.tcl
+++ /dev/null
@@ -1,455 +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_prefs 0.1
-
-#package require pd_bindings
-#package require dialog_gui
-
-namespace eval ::dialog_prefs:: {
-# namespace export pdtk_
-}
-
-# mytoplevel isn't used here, but is kept for compatibility with other dialog ok procs
-proc ::dialog_prefs::ok {mytoplevel} {
- return # hash this out later
- variable find_history
-
- 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_prefs::cancel {mytoplevel} {
- wm withdraw .prefs
-}
-
-# the find panel is opened from the menu and key bindings
-proc ::dialog_prefs::open_prefs_dialog {mytoplevel} {
- if {[winfo exists .prefs]} {
- wm deiconify .prefs
- raise .prefs
- # obtain last known mouse coords and pop the menu there
- global pointer_x_global pointer_y_global
- wm geometry .prefs "+$pointer_x_global+$pointer_y_global"
- } else {
- create_dialog $mytoplevel
- }
- pd [concat pd audio-properties \;]
- pd [concat pd midi-properties \;]
- ::dialog_gui::create_gui_dialog .prefs.nb.gui
-# need to think about what should get focus with ttk::notebook
-# .prefs.entry selection range 0 end
-}
-
-proc ::dialog_prefs::dropdown_set {name value} {
- if {$::windowingsystem eq "aqua"} {
- set my_var [$name cget -textvariable]
- set $my_var $value
- } else {
- $name set "$value"
- }
-}
-
-proc ::dialog_prefs::dropdown_by_index {name variable values textvar} {
- ::dialog_prefs::dropdown $name $variable $values $textvar
-}
-
-proc ::dialog_prefs::dropdown {name variable values args} {
- set textvar $variable
- if {$args ne ""} {set textvar $args}
- if {$::windowingsystem eq "aqua"} {
- ttk::menubutton $name -menu $name.menu -direction flush \
- -textvariable $textvar -cursor boat
- menu $name.menu -cursor boat
- set i 0
- foreach label $values {
- set value $label
- if {$args ne ""} {set value $i}
- $name.menu add radiobutton -value $value -variable $variable \
- -label $label -command "set $textvar \"$label\""
- incr i
- }
- } else {
- # set combobox width to largest string
- set width 0
- foreach value $values {
- set len [string length $value]
- set width [expr $len > $width ? $len : $width]
- }
- ttk::combobox $name -state readonly -width $width \
- -style Prefs.TCombobox -values $values
- set command "get"
- if {$args ne ""} {
- set command "current"
- # the following cmd prevents a bug in the alsa midi api
- # from throwing an index that's out of range. but once
- # that bug gets fixed, this should be removed so that
- # it doesn't hide any future bugs
- set $variable [expr min([set $variable], [llength $values] - 1)]
- }
- bind $name <<ComboboxSelected>> "set $variable \
- [concat {[} $name $command {]} ]; after 0 {%W selection clear}"
- if {$command eq "get"} {set command "set"}
- $name $command [set $variable]
- }
-}
-
-proc ::dialog_prefs::set_color {array key op} {
- # not sure if this is necessary, but just in case...
- if {$op ne "write"} {return}
- set c [set ${array}($key)]
- set commands {}
- switch $key {
- box {set commands [list "itemconfigure \
- box&&(!msg)&&(!atom) -fill $c"] }
- text { set commands [list "itemconfigure \
- (text&&(!box&&!iemgui)) -fill $c"]
- lappend commands "itemconfigure \
- label&&graph -fill $c"
- # lappend commands "itemconfigure \
- # (text&&(!label) -fill $c"
- if {[winfo exists .search.resultstext]} {
- .search.resultstext configure -foreground $c
- .search.navtext configure -foreground $c
- }
- }
- text_in_console {
- if {[winfo exists .printout.frame.text]} {
- .printout.frame.text configure -foreground $c
- }
- }
- canvas_color {set commands [list "configure -bg $c"]
- if {[winfo exists .search.resultstext]} {
- .search.resultstext configure -bg $c
- .search.navtext configure -bg $c
- }
- if {[winfo exists .printout.frame.text]} {
- .printout.frame.text configure -bg $c
- }
- }
- canvas_cursor {set commands [list "configure -insertbackground $c"]}
- highlighted_text_bg \
- {set commands [list "configure -selectbackground $c"]}
- highlighted_text {set commands [list "configure -selectforeground $c"]}
- msg_border {set commands [list "itemconfigure \
- msg&&box -stroke $c"]}
- msg {set commands [list "itemconfigure \
- msg&&box -fill $c"]}
- control_nlet {set commands [list "itemconfigure \
- ((inlet||outlet)&&control) -fill $c"]
- }
- iemgui_nlet {set commands [list "itemconfigure \
- (inlet&&iemgui)||(outlet&&iemgui) -stroke $c"]
- }
- signal_nlet {set commands [list "itemconfigure \
- inlet&&signal -fill $c"]
- lappend commands "itemconfigure \
- outlet&&signal -fill $c"
- }
- #outlet {set commands [list "itemconfigure outlet -stroke $c"]}
- signal_cord {set commands [list "itemconfigure \
- all_cords&&signal -stroke $c"]
- lappend commands "itemconfigure \
- (outlet&&signal)||(inlet&&signal) -stroke $c"
- }
- control_cord {set commands [list "itemconfigure \
- all_cords&&control -stroke $c"]
- lappend commands "itemconfigure \
- ((inlet||outlet)&&control) -stroke $c"
- }
- selection {
- set commands [list "itemconfigure \
- selected&&text&&(!box&&!iemgui) -fill $c"]
- lappend commands "itemconfigure \
- selected&&(border&&(!iemgui)) -fill $c"
- lappend commands "itemconfigure \
- selected&&border&&iemgui -stroke $c"
- }
- box_border {set commands [list "itemconfigure \
- (box)&&(!iemgui) -stroke $c"]}
- iemgui_border {
- set commands [list "itemconfigure border&&iemgui -stroke $c"]}
- atom_box {set commands [list "itemconfigure \
- atom&&box -fill $c"]}
- atom_box_border {set commands [list "itemconfigure \
- atom&&box -stroke $c"]}
- graph_border {set commands [list "itemconfigure \
- graph&&(!label) -stroke $c"]}
- graph {set commands [list "itemconfigure graph&&(!label) -fill $c"]}
- dash_fill {
- set commands [list "itemconfigure broken&&box -fill $c"]
- if {[winfo exists .printout.frame.text]} {
- .printout.frame.text tag configure errorlink -background $c
- }
- }
- dash_outline {
- set commands [list "itemconfigure broken&&box -stroke $c"]
- if {[winfo exists .printout.frame.text]} {
- .printout.frame.text tag configure errorlink -foreground $c
- }
- }
-
-
-
- magic_glass_bg {set commands [list "itemconfigure \
- magicGlassBg -fill $c"]}
- magic_glass_bd {set commands [list "itemconfigure \
- magicGlassLine -fill $c"]}
- magic_glass_text {set commands [list "itemconfigure \
- magicGlassText -fill $c"]}
- link {
- if {[winfo exists .search.resultstext]} {
- .search.resultstext tag configure link -foreground $c
- .search.navtext tag configure link -foreground $c
- .search.f.advancedlabel configure -foreground $c
- }
- # return
- }
- default {}
- }
- if {$commands ne ""} {
- foreach w [winfo children .] {
- foreach child [winfo children $w] {
- if {$child ne "" && [winfo class $child] eq "PathCanvas"} {
- if {$key eq "canvas_color" &&
- [info exists [format ::%s(%s) $key $w]]} {
- continue
- }
- foreach command $commands {
- eval $child $command
- }
- }
- }
- }
- }
- # hack! how do I avoid hard-coding the window names here?
- set mytoplevel .prefs.nb.gui.colors
- if {[winfo exists $mytoplevel.$key]} {
- ::dialog_prefs::set_swatchbutton $mytoplevel.$key ${array}($key)
- }
-
-}
-
-proc ::dialog_prefs::set_swatchbutton {name variable} {
- if {[set $variable] eq ""} {return}
- image create photo ::img::swatchbutton::$name
- set c [set $variable]
- set bd #000000
- set stupid_top_and_bottom \
- [list $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd $bd]
- set dumb \
- [list $bd $c $c $c $c $c $c $c $c $c $c $bd]
- ::img::swatchbutton::$name put [list $stupid_top_and_bottom \
- $dumb $dumb $dumb $dumb $dumb $dumb $dumb $dumb \
- $dumb $dumb $stupid_top_and_bottom] -to 0 0 12 12
- $name configure -image ::img::swatchbutton::$name
-}
-
-proc ::dialog_prefs::swatchmenu_nav {w dir} {
- set new [expr {[$w index active] + 7 * $dir}]
- if {$new > [$w index end] || $new < 0} then return
- $w activate $new
-}
-
-proc ::dialog_prefs::swatchbutton_colorchooser {name variable} {
- set col [tk_chooseColor -parent $name -initialcolor [set $variable]]
- if {$col ne ""} {
- set $variable $col
- # kludge since the dialog has static name for colors, we refer to it here
- # with partially modular approach that should hopefully prove universal
- set combobox [string trimright $name .link]
- ::dialog_prefs::dropdown_set $combobox.presets.presets Custom
- ::pd_guiprefs::write_guipreset
- }
-}
-
-proc ::dialog_prefs::swatchbutton {name variable} {
- ttk::button $name \
- -command "::dialog_prefs::swatchbutton_colorchooser $name $variable"
-}
-
-# These are images used to build the menu for choosing
-# colors. The images hang around in memory until you exit
-# Pd, but they shouldn't take up too much space to matter
-# (and this only gets called once). If there's a simpler
-# way to build a _straightforward_ _user-friendly_
-# colorchooser that would be nice, but I couldn't figure
-# one out.
-proc ::dialog_prefs::get_colorswatches {} {
- # stolen from the Firefox colorchooser
- set colors { \
- #ffffff #cfcccc #c0c0c0 #999999 #666666 #333333 #000000 \
- #ffcccc #ff6666 #ff0000 #cc0000 #990000 #660000 #330000 \
- #ffcc99 #ff9966 #ff9900 #ff6600 #cc6600 #993300 #663300 \
- #ffff99 #ffff66 #ffcc66 #ffcc33 #cc9933 #996633 #663333 \
- #ffffcc #ffff33 #ffff00 #ffcc00 #999900 #666600 #333300 \
- #99ff99 #66ff99 #33ff33 #33cc00 #009900 #006600 #003300 \
- #99ffff #33ffff #66cccc #00cccc #339999 #336666 #003333 \
- #ccffff #66ffff #33ccff #3366ff #3333ff #000099 #000066 \
- #ccccff #9999ff #6666cc #6633ff #6600cc #333399 #330099 \
- #ffccff #ff99ff #cc66cc #cc33cc #993399 #663366 #330033 \
- }
- if {[lsearch [image names] ::img::colorswatches::*] == -1} {
- foreach color $colors {
- image create photo ::img::colorswatches::$color
- ::img::colorswatches::$color put $color -to 0 0 16 16
- }
- }
- return $colors
-}
-
-proc ::dialog_prefs::help {notebook} {
- set pane [$notebook select]
- regsub {.*\.(.*)} $pane {\1} topic
- set file all_about_${topic}_settings.pd
- set dir [file join $::sys_libdir doc 5.reference]
- menu_doc_open $dir $file
-}
-
-proc ::dialog_prefs::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 ::dialog_prefs::create_dialog {mytoplevel} {
- toplevel .prefs -class [winfo class .]
- wm title .prefs [_ "Pure Data Preferences"]
-# wm geometry .prefs =475x125+150+150
- wm group .prefs .
- wm resizable .prefs 0 0
- wm transient .prefs
-
- # obtain last known mouse coords and pop the menu there
- global pointer_x_global pointer_y_global
- if {$pointer_x_global == 0 && $pointer_y_global == 0} {
- set pointer_x_global [expr [winfo rootx .]+30]
- set pointer_y_global [expr [winfo rooty .]+30]
- }
- wm geometry .prefs "+$pointer_x_global+$pointer_y_global"
-
-# .prefs configure -menu $::dialog_menubar
-
-# todo: check this on the mac and on windows
-# .prefs configure -padx 10 -pady 5
- ::dialog_prefs::dialog_bindings .prefs "prefs"
- bind .prefs <$::modifier-Key-f> break
-
- # Ttk style setup
-
- # Common settings
- ttk::style configure Prefs.TLabelframe -borderwidth 0
- # todo: don't hardcode font here
- ttk::style configure Prefs.TLabelframe.Label \
- -font "{DejaVu Sans} 9 bold"
-
- # for OSX swatchbutton
- if {$::windowingsystem eq "x11"} {
- # custom arrow image for ttk::combobox
- set ::prefs_arrowimg [image create photo -data \
- {R0lGODlhGQAVAMIGACEhIVBQUFpaWl1dXXBwcImJif///////yH+EUNyZWF0ZWQg
- d2l0aCBHSU1QACH5BAEKAAcALAAAAAAZABUAAAMleLrc/jDKSau9OOutC/ggUGRE
- CBCbAArcEQBBqwxybd94ru9QAgA7
- }]
- # ttk::style theme use clam
- ttk::style element create Prefs.downarrow image $::prefs_arrowimg
- ttk::style layout Prefs.TCombobox {
- Combobox.focus -sticky nsew -children {
- Combobox.field -sticky nswe -children {
- Prefs.downarrow -side right -sticky ns
- Combobox.padding -expand 1 -sticky nswe -children {
- Combobox.textarea -sticky nswe
- }
- }
- }
- }
- ttk::style layout PrefsColors.TMenubutton {
- Menubutton.border -sticky nswe -children {
- Menubutton.focus -sticky nswe -children {
- Menubutton.padding -expand 1 -sticky we -children {
- Menubutton.label -side left -sticky {}
- }
- }
- }
- }
- ttk::style configure Prefs.TCombobox -padding 3
- ttk::style map Prefs.TCombobox \
- -fieldbackground {{readonly pressed} #c1c4c7 \
- {readonly hover} #fafaf9 \
- readonly #f5f5f4} \
- -foreground {{readonly focus} black}
- # this shouldn't be global, but I can't get it to work for just
- # Prefsdialog class
- option add *TCombobox*Listbox.selectBackground #4a90d9
- option add *TCombobox*Listbox.selectForeground white
- }
-
- ttk::notebook .prefs.nb
- .prefs.nb add [ttk::frame .prefs.nb.audio -padding 10] \
- -text "Audio" -sticky nsew
- .prefs.nb add [ttk::frame .prefs.nb.midi -padding 10] \
- -text "MIDI" -sticky nsew
- .prefs.nb add [ttk::frame .prefs.nb.gui -padding 10] \
- -text "GUI" -stick nsew
- pack .prefs.nb -fill both -expand 1
-
- ttk::frame .prefs.bottomframe -padding 10
- pack .prefs.bottomframe -side bottom -fill both -expand 1
- if {$::windowingsystem ne "aqua"} {
- ttk::button .prefs.bottomframe.closebutton \
- -text "Close" -command "::dialog_prefs::cancel .prefs"
- pack .prefs.bottomframe.closebutton -side right
- }
- ttk::button .prefs.bottomframe.helpbutton \
- -text "Help" -command "::dialog_prefs::help .prefs.nb"
- pack .prefs.bottomframe.helpbutton -side left
-}
diff --git a/pd/src/helpbrowser.tcl b/pd/src/helpbrowser.tcl
deleted file mode 100644
index d1d0f96de7f38206fb5f1cccd87c90d815619198..0000000000000000000000000000000000000000
--- a/pd/src/helpbrowser.tcl
+++ /dev/null
@@ -1,291 +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 [winfo class .]
- wm group .help_browser .
- wm transient .help_browser
- wm title .help_browser [_ "Help Browser"]
- if {$::pd_nt == 2} {.help_browser configure -menu $::dialog_menubar}
- bind .help_browser <$::modifier-Key-w> "wm withdraw .help_browser"
-
- wm resizable .help_browser 0 0
- match_linux_wm [list frame .help_browser.frame]
- pack .help_browser.frame -side top -fill both
- build_references
-# doc_make_listbox .help_browser.frame $::sys_libdir/doc 0
- make_rootlistbox .help_browser.frame
-
- bind .help_browser <Control-Next> {menu_raisenextwindow}
- bind .help_browser <Key> {pdtk_capture_root_window_keys 1 %K %A 0}
- bind .help_browser <Shift-Key> {pdtk_capture_root_window_keys 1 %K %A 1}
- bind .help_browser <KeyRelease> {pdtk_capture_root_window_keys 0 %K %A 0}
- bind .help_browser <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind .help_browser <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
- }
-}
-
-# 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 "#e87216" -selectborderwidth 0 \
- -height 20 -width 23 -exportselection 0 -bd 0 \
- -selectbackground "#e87216"]
- pack $current_listbox [match_linux_wm [list 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_key_navigate %W $current_listbox]
- 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
- }
-}
-
-proc ::helpbrowser::root_key_navigate {window current_listbox} {
- variable reference_paths
- if {[set item [$window get [$window index [$current_listbox curselection]]]] 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::warn "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 "#e87216" -selectborderwidth 0 \
- -height 20 -width 23 -exportselection 0 -bd 0 \
- -selectbackground "#e87216"]
- pack $current_listbox [match_linux_wm [list 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 "#e87216" -selectborderwidth 0 \
- -height 20 -width 23 -exportselection 0 -bd 0 \
- -selectbackground "#e87216"]
- pack $current_listbox [match_linux_wm [list 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/" " Manuals/" "-----------------------"}
- variable helplist {}
- variable reference_count
- variable reference_paths
-
- array set reference_count {}
- array set reference_paths [list \
- " Pure Data/" $::sys_libdir/doc \
- " Manuals/" $::sys_libdir/doc/manuals \
- "-----------------------" "" \
- ]
- set my_pd_path [concat $::pd_path [list [file join $::sys_libdir extra]]]
- foreach pathdir $my_pd_path {
- 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/src/pd_guiprefs.tcl b/pd/src/pd_guiprefs.tcl
deleted file mode 100644
index 96c7ed8f5ac49068debba049887be6344e12f212..0000000000000000000000000000000000000000
--- a/pd/src/pd_guiprefs.tcl
+++ /dev/null
@@ -1,339 +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 ""
-set ::guipreset_key ""
-set ::guipreset_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]}
- set ::gui_preset ""
- catch {
- set ::gui_preset [get_config $::guipreset_domain $::guipreset_key $arr]
- if { [lindex $::gui_preset 0] == "Custom" } {
- set ::pd_colors(atom_box) [lindex $::gui_preset 1]
- set ::pd_colors(atom_box_border) [lindex $::gui_preset 2]
- set ::pd_colors(canvas_color) [lindex $::gui_preset 3]
- set ::pd_colors(canvas_cursor) [lindex $::gui_preset 4]
- set ::pd_colors(text) [lindex $::gui_preset 5]
- set ::pd_colors(text_in_console) [lindex $::gui_preset 6]
- set ::pd_colors(box) [lindex $::gui_preset 7]
- set ::pd_colors(box_border) [lindex $::gui_preset 8]
- set ::pd_colors(msg) [lindex $::gui_preset 9]
- set ::pd_colors(msg_border) [lindex $::gui_preset 10]
- set ::pd_colors(iemgui_border) [lindex $::gui_preset 11]
- set ::pd_colors(iemgui_nlet) [lindex $::gui_preset 12]
- set ::pd_colors(control_cord) [lindex $::gui_preset 13]
- set ::pd_colors(control_nlet) [lindex $::gui_preset 14]
- set ::pd_colors(signal_cord) [lindex $::gui_preset 15]
- set ::pd_colors(signal_nlet) [lindex $::gui_preset 16]
- set ::pd_colors(xlet_hover) [lindex $::gui_preset 17]
- set ::pd_colors(link) [lindex $::gui_preset 18]
- set ::pd_colors(selection) [lindex $::gui_preset 19]
- set ::pd_colors(selection_rectangle) [lindex $::gui_preset 20]
- set ::pd_colors(highlighted_text) [lindex $::gui_preset 21]
- set ::pd_colors(highlighted_text_bg) [lindex $::gui_preset 22]
- set ::pd_colors(dash_outline) [lindex $::gui_preset 23]
- set ::pd_colors(dash_fill) [lindex $::gui_preset 24]
- set ::pd_colors(graph_border) [lindex $::gui_preset 25]
- set ::pd_colors(graph) [lindex $::gui_preset 26]
- set ::pd_colors(magic_glass_bg) [lindex $::gui_preset 27]
- set ::pd_colors(magic_glass_bd) [lindex $::gui_preset 28]
- set ::pd_colors(magic_glass_text) [lindex $::gui_preset 29]
- set ::pd_colors(magic_glass_flash) [lindex $::gui_preset 30]
- set ::gui_preset [lindex $::gui_preset 0]
- }
-
- }
-}
-
-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
- set ::guipreset_domain org.puredata
- set ::guipreset_key "GuiPreset"
-}
-
-proc ::pd_guiprefs::init_win {} {
- # windows uses registry
- set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pd-L2Ork"
- set ::recentfiles_key "RecentDocs"
- set ::guipreset_domain "HKEY_CURRENT_USER\\Software\\Pd-L2Ork"
- set ::guipreset_key "GuiPreset"
-
-}
-
-proc ::pd_guiprefs::init_x11 {} {
- # linux uses ~/.config/pure-data dir
- set ::recentfiles_domain "~/.pd-l2ork"
- set ::recentfiles_key "recent_files"
- set ::guipreset_domain "~/.pd-l2ork"
- set ::guipreset_key "gui_theme"
- prepare_configdir
-}
-
-# ------------------------------------------------------------------------------
-# write recent files
-#
-proc ::pd_guiprefs::write_recentfiles {} {
- write_config $::recentfiles_list $::recentfiles_domain $::recentfiles_key true
-}
-
-proc ::pd_guiprefs::write_guipreset {} {
- set output $::gui_preset
- if { $::gui_preset == "Custom" } {
- lappend output $::pd_colors(atom_box)
- lappend output $::pd_colors(atom_box_border)
- lappend output $::pd_colors(canvas_color)
- lappend output $::pd_colors(canvas_cursor)
- lappend output $::pd_colors(text)
- lappend output $::pd_colors(text_in_console)
- lappend output $::pd_colors(box)
- lappend output $::pd_colors(box_border)
- lappend output $::pd_colors(msg)
- lappend output $::pd_colors(msg_border)
- lappend output $::pd_colors(iemgui_border)
- lappend output $::pd_colors(iemgui_nlet)
- lappend output $::pd_colors(control_cord)
- lappend output $::pd_colors(control_nlet)
- lappend output $::pd_colors(signal_cord)
- lappend output $::pd_colors(signal_nlet)
- lappend output $::pd_colors(xlet_hover)
- lappend output $::pd_colors(link)
- lappend output $::pd_colors(selection)
- lappend output $::pd_colors(selection_rectangle)
- lappend output $::pd_colors(highlighted_text)
- lappend output $::pd_colors(highlighted_text_bg)
- lappend output $::pd_colors(dash_outline)
- lappend output $::pd_colors(dash_fill)
- lappend output $::pd_colors(graph_border)
- lappend output $::pd_colors(graph)
- lappend output $::pd_colors(magic_glass_bg)
- lappend output $::pd_colors(magic_glass_bd)
- lappend output $::pd_colors(magic_glass_text)
- lappend output $::pd_colors(magic_glass_flash)
- }
- write_config $output $::guipreset_domain $::guipreset_key true
-}
-
-# ------------------------------------------------------------------------------
-# this is called when opening a document (wheredoesthisshouldgo.tcl)
-#
-proc ::pd_guiprefs::update_recentfiles {afile save} {
- # remove duplicates first
- set index [lsearch -exact $::recentfiles_list $afile]
- set ::recentfiles_list [lreplace $::recentfiles_list $index $index]
- #puts stderr "afile=$afile save=$save"
- # 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 [expr $::total_recentfiles - 1]]
- #::pd_menus::update_recentfiles_menu .mbar.file $save
- ::pd_guiprefs::write_recentfiles
-}
-
-proc ::pd_guiprefs::update_guipreset {preset} {
- set ::gui_preset $preset
- ::pd_guiprefs::write_guipreset
-}
-
-#################################################################
-# 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 split into individual entries
-#
-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 "Created $::recentfiles_domain preferences folder.\n"
- }
-}
-
-# ------------------------------------------------------------------------------
-# osx: handles arrays in plist files (thanks hc)
-#
-proc ::pd_guiprefs::plist_array_to_tcl_list {arr} {
- set result {}
- set filelist $arr
- regsub -all -- {("?),\s+("?)} $filelist {\1 \2} filelist
- regsub -all -- {\n} $filelist {} filelist
- regsub -all -- {^\(} $filelist {} filelist
- regsub -all -- {\)$} $filelist {} filelist
- regsub -line -- {^'(.*)'$} $filelist {\1} filelist
-
- foreach file $filelist {
- set filename [regsub -- {,$} $file {}]
- lappend result $filename
- }
- return $result
-}
-
-# the Mac OS X 'defaults' command uses single quotes to quote things,
-# so they need to be escaped
-proc ::pd_guiprefs::escape_for_plist {str} {
- return [regsub -all -- {'} $str {\\'}]
-}
diff --git a/pd/src/pd_menus_SHORT.tcl b/pd/src/pd_menus_SHORT.tcl
deleted file mode 100644
index 929e985c016163e4b4e3bb10ed5bf12dac4d9f42..0000000000000000000000000000000000000000
--- a/pd/src/pd_menus_SHORT.tcl
+++ /dev/null
@@ -1,93 +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 ".mbar"
-
- namespace export create_menubar
- namespace export configure_for_pdwindow
- namespace export configure_for_canvas
- namespace export configure_for_dialog
-
- # turn off tearoff menus globally
- option add *tearOff 0
-}
-
-# ------------------------------------------------------------------------------
-# update the menu entries for opening recent files (write arg should always be true except the first time when pd is opened)
-proc ::pd_menus::update_recentfiles_menu {menu {write true}} {
- #variable menubar
- switch -- $::windowingsystem {
- "aqua" {::pd_menus::update_openrecent_menu_aqua $menu $write}
- "win32" {::pd_menus::update_recentfiles_on_menu $menu $write}
- "x11" {::pd_menus::update_recentfiles_on_menu $menu $write}
- }
-}
-
-proc ::pd_menus::clear_recentfiles_menu {} {
- set ::recentfiles_list {}
- #::pd_menus::update_recentfiles_menu
- # empty recentfiles in preferences (write empty array)
- ::pd_guiprefs::write_recentfiles
-}
-
-proc ::pd_menus::update_openrecent_menu_aqua {mymenu {write}} {
- if {! [winfo exists $mymenu]} {menu $mymenu}
- $mymenu delete 0 end
-
- # now the list is last first so we just add
- foreach filename $::recentfiles_list {
- $mymenu add command -label [file tail $filename] \
- -command "open_file {$filename}"
- }
- # clear button
- $mymenu add separator
- $mymenu add command -label [_ "Clear Menu"] \
- -command "::pd_menus::clear_recentfiles_menu"
- # write to config file
- if {$write == true} { ::pd_guiprefs::write_recentfiles }
-}
-
-# this expects to be run on the File menu, and to insert above the last separator
-proc ::pd_menus::update_recentfiles_on_menu {mymenu {write}} {
- set lastitem [$mymenu index end]
- set i 0
- while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {incr i}
- set bottom_separator [expr $lastitem-$i]
- incr i
-
- while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {incr i}
- set top_separator [expr $lastitem-$i]
- if {$top_separator < [expr $bottom_separator-1]} {
- $mymenu delete [expr $top_separator+1] [expr $bottom_separator-1]
- }
- # insert the list from the end because we insert each element on the top
- set i [llength $::recentfiles_list]
- while {[incr i -1] > 0} {
-
- set filename [lindex $::recentfiles_list $i]
- $mymenu insert [expr $top_separator+1] command \
- -label [file tail $filename] -command "open_file {$filename}"
- }
- if { [llength $::recentfiles_list] > 0 } {
- set filename [lindex $::recentfiles_list 0]
- $mymenu insert [expr $top_separator+1] command \
- -label [file tail $filename] -command "open_file {$filename}"
- } else {
- $mymenu insert [expr $top_separator+1] command -label "No Recent Files" -state disabled
- }
- # write to config file
- if {$write == true} { ::pd_guiprefs::write_recentfiles }
-}
\ No newline at end of file
diff --git a/pd/src/pdtk_drawimage.tcl b/pd/src/pdtk_drawimage.tcl
deleted file mode 100644
index a4dda9efb2e3f120d3a8952d023a9663c3080f8d..0000000000000000000000000000000000000000
--- a/pd/src/pdtk_drawimage.tcl
+++ /dev/null
@@ -1,93 +0,0 @@
-#todo: rename img to imgprefix
-
-# package provide pdtk_drawimage 0.1
-# package require tkpng
-
-namespace eval ::pdtk_drawimage:: {
- namespace export pdtk_drawimage_new
- namespace export pdtk_drawimage_vis
-}
-
-# Some GUI procs for [drawimage] and [drawsprite]
-
-# Draw an image
-proc pdtk_drawimage_new {obj path canvasdir flags} {
- set drawsprite 1
- set image_seq [expr {$flags & $drawsprite}]
- # obj - .x%lx name for [drawimage] instance
- # path - this is absolute or relative
- # for [drawsprite] this is the directory of the image sequence
- # for [drawimage] this is the file path of the image
- # canvasdir - relative paths should be relative to this
- # (any other possibilities?)
- set i 0
- set matchchar *
- # this will discard $canvasdir for absolute paths, which is nice
- set path [file normalize [file join $canvasdir $path]]
- if {[file isdir $path]} {
- # put a final directory separator for a dir
- set path [string trimright [file join $path { }]]
- } else {
- # if it's a file we don't want a wildcard character
- set matchchar {}
- }
- if {![file exists $path]} {
- pdtk_post "drawimage: warning: path doesn't exist: $path\n"
- pd [concat $obj size 1 1 \;]
- return
- }
- foreach filename [lsort -dictionary [glob -nocomplain -type {f r} \
- -path $path $matchchar]] {
- if {[file extension $filename] eq ".gif" ||
- [file extension $filename] eq ".png"} {
- image create photo ::drawimage_${obj}$i -file "$filename"
- #pdtk_post "image is ::drawimage_${obj}$i\n"
- incr i
- }
- if {$i > 1000 || !$image_seq} {break}
- }
- pdtk_post "no of files: $i\n"
- # we bound a symbol to $img in drawimage_new, so we
- # can send back a message with the image dimensions
- # to be used for the selection bbox. This is dumb--
- # pd has no business handling a gui issue like size
- # of a selection rectangle. That's what Tk is for.
- # But that's a bigger issue to be dealt with later.
- if {$i > 0} {
- pdtk_post "image width is [image width ::drawimage_${obj}0]\n"
- pdtk_post "image height is [image height ::drawimage_${obj}0]\n"
- #pdtk_post "obj is $obj\n"
- pd [concat $obj size [image width ::drawimage_${obj}0] \
- [image height ::drawimage_${obj}0] \;]
- } else {
- pdtk_post "drawimage: warning: no images loaded"
- }
-}
-
-proc pdtk_drawimage_vis {c x y obj tag seqno l2orktag1 l2orktag2 tag3 drawtag} {
- set img ::drawimage_${obj}
- set len [llength [lsearch -glob -all [image names] ${img}*]]
- if {$len < 1} {return}
- if {$seqno >= $len || $seqno < 0} {set seqno [expr {$seqno % $len}]}
- $c create pimage $x $y -image ${img}$seqno -tags [list $tag $l2orktag1 $l2orktag2 $drawtag] -parent $tag3
-}
-
-proc pdtk_drawimage_index {c obj drawtag index} {
- set img ::drawimage_${obj}
- $c itemconfigure $drawtag -image ${img}$index
-}
-
-proc pdtk_drawimage_unvis {c tag} {
- $c delete $tag
-}
-
-proc pdtk_drawimage_free {img} {
-# image delete [lsearch -glob -all -inline [image names] ::drawimage_${img}*]
-
- foreach globalimage [image names] {
- if {[lsearch -glob $globalimage ::drawimage_${img}*] != -1} {
- image delete $globalimage
- pdtk_post "Deleted $globalimage\n"
- }
- }
-}
diff --git a/pd/src/pkgIndex.tcl b/pd/src/pkgIndex.tcl
deleted file mode 100644
index a627664ebbc110a543f54cbdfeb5a4999481ce32..0000000000000000000000000000000000000000
--- a/pd/src/pkgIndex.tcl
+++ /dev/null
@@ -1,26 +0,0 @@
-# pkgIndex.tcl. Generated from pkgIndex.tcl.in by configure.
-#
-
-package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
-package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]]
-package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus_SHORT.tcl]]
-
-namespace eval ::tkpath {
- proc load_package {dir} {
- load [file join $dir libtkpath0.3.3.so]
- # Allow optional redirect of library components.
- # Only necessary for testing, but could be used elsewhere.
- if {[info exists ::env(TKPATH_LIBRARY)]} {
- set dir $::env(TKPATH_LIBRARY)
- }
- source $dir/tkpath.tcl
- };# load_package
-}
-
-package ifneeded tkpath 0.3.3 [list ::tkpath::load_package $dir]
-
-package ifneeded tkdnd 2.6 \
- "source \{$dir/tkdnd.tcl\} ; \
- tkdnd::initialise \{$dir\} libtkdnd2.6.so tkdnd"
-
-#*EOF*
diff --git a/pd/src/search-plugin.tcl b/pd/src/search-plugin.tcl
deleted file mode 100644
index 4bd1a5e3fdf1bf6d55fd1e21d9c33d107131fd6c..0000000000000000000000000000000000000000
--- a/pd/src/search-plugin.tcl
+++ /dev/null
@@ -1,1644 +0,0 @@
-# browse docs or search all the documentation using a regexp
-# check the Help menu for the Browser item to use it
-
-# done: field descriptors, including xlet details
-# done: parse extant pdfs, htmls
-# done: Gem help patch descriptions
-
-# todo: logic for where to store the index
-# todo: make libdir listing check for duplicates
-# todo: hook into the dialog_bindings
-# TODO remove the doc_ prefix on procs where it's not needed
-# TODO enter and up/down/left/right arrow key bindings for nav
-
-# redesign:
-# [ ---- search entry ---- ] Help
-# [search] [filter]
-#
-
-package require Tk 8.5
-# package require pd_bindings
-# package require pd_menucommands
-package require xapian 1.0.0
-
-namespace eval ::dialog_search:: {
-
- variable doctypes "*.{pd,pat,mxb,mxt,help,txt,htm,html,pdf}"
-
- variable searchfont [list {DejaVu Sans}]
- variable searchtext {}
- variable search_history {}
- # search direction for the Firefox style "find"
- variable fff_direction forwards
- variable fff_viskey 0 # hack
- variable count {}
- # $i controls the build_index recursive loop
- variable i
- variable filelist {}
- variable progress {}
- variable navbar {}
- variable genres
- variable cancelled
- variable database {}
- # the dbpath needs to be made more general for OSX and Windows
- variable dbpath [file join [file nativename ~] .pd-l2ork doc_index]
- variable metakeys { alias XA license XL description XD \
- release_date XR author A help_patch_author XHA \
- keywords K \
- inlet_0 XIA inlet_1 XIB inlet_2 XIC \
- inlet_3 XID inlet_4 XIE inlet_5 XIF \
- inlet_6 XIG inlet_7 XIH inlet_8 XII \
- inlet_n XIN inlet_r XIR \
- outlet_0 XOA outlet_1 XOB outlet_2 XOC \
- outlet_3 XOD outlet_4 XOE outlet_5 XOF \
- outlet_6 XOG outlet_7 XOH outlet_8 XOI \
- outlet_n XON outlet_r XOR \
- }
-}
-
-################## help browser and support functions #########################
-proc ::dialog_search::open_helpbrowser {mytoplevel} {
- reset_ctrl_on_popup_window
- if {[winfo exists $mytoplevel]} {
- wm deiconify $mytoplevel
- raise $mytoplevel
- } else {
- create_dialog $mytoplevel
- }
-}
-
-# insert rows or columns into a grid
-# grid: the geometry master
-# what: row or column
-# index: where to insert
-# count: how many rows/cols to insert
-proc ::dialog_search::grid_insert {grid what index {count 1}} {
- foreach slave [grid slaves $grid] {
- array set info [grid info $slave]
- if {$info(-$what) >= $index} {
- incr info(-$what) $count
- eval {grid $slave} [array get info]
- } elseif {$info(-$what)+$info(-${what}span) > $index} {
- incr info(-${what}span) $count
- eval {grid $slave} [array get info]
- }
- }
-}
-
-# Used by fff_bar to highlight and navigate to words/text
-# within the results (Like firefox's "Find" window bar
-proc ::dialog_search::resultstext_search {w key} {
- # filter out unwanted keys
- if {[lsearch -exact $key {37}] ne -1} {return}
- # filter out KeyRelease from shortcut that
- # makes the fff row visible. The above filter
- # should catch a <ctrl> code, so we should just
- # be left with 'f' (41)
- if {$::dialog_search::fff_viskey} {
- set ::dialog_search::fff_viskey 0
- return
- }
- if {[lsearch -exact [grid slaves [winfo toplevel $w]] [winfo parent $w]] \
- eq "-1" || [$w get] eq ""} {
- return
- }
- set resultstext .search.resultstext
- $resultstext tag remove sel 1.0 end
- set fff_string [$w get]
- set offset 1
- if {$::dialog_search::fff_direction eq "backwards"} {
- set offset -1
- }
- if {$key == "36" || $key == "104"} {
- $resultstext mark set insert \
- "[$resultstext index insert] + $offset display chars"
- }
- set insert [$resultstext index insert]
- set count ""
- set match ""
- set match [$resultstext search -$::dialog_search::fff_direction \
- -nocase -count count -- $fff_string $insert]
- if {$match ne ""} {
- $resultstext see $match
- $resultstext tag add sel $match "$match + $count display chars"
- $resultstext mark set insert $match
- }
-}
-
-proc ::dialog_search::toggle_fff_bar {mytoplevel} {
- # todo: standardize fff bar padding
- # widgets for the fff bar
- set f $mytoplevel.fff
- set e $f.e
- if {[lsearch -exact [grid slaves $mytoplevel] $f] ne -1} {
- grid forget $f
- focus .search.f.searchtextentry
- } else {
- if {![winfo exists $f]} {
- ttk::frame $f
- ttk::label $f.l -text "Find: "
- ttk::entry $f.e
- ttk::style configure Fff.TButton -padding {0 0}
- ttk::button $f.p -text "Previous" -style Fff.TButton \
- -command "::dialog_search::fff_navigate $e backwards"
- bind $f.p <Key-Return> "$f.p invoke"
- bind $f.p <Key-KP_Enter> "$f.p invoke"
- ttk::button $f.n -text "Next" -style Fff.TButton \
- -command "::dialog_search::fff_navigate $e forwards"
- bind $f.n <Key-Return> "$f.n invoke"
- bind $f.n <Key-KP_Enter> "$f.n invoke"
- grid $f.l $f.e $f.p $f.n
- bind $e <KeyRelease> "::dialog_search::resultstext_search %W %k"
- }
- grid_insert $mytoplevel row 4 1
- grid $f -row 4 -columnspan 3 -sticky w -padx 4 -pady 4
- # we have to set a flag to let the other fff proc
- # filter this 'f' KeyRelease (from <ctrl-f> shortcut)
- # which makes the fff row visible
- set ::dialog_search::fff_viskey 1
- focus $e
- }
-}
-
-proc ::dialog_search::fff_navigate {w dir} {
- set ::dialog_search::fff_direction $dir
- resultstext_search $w 36
-}
-
-# this is stolen from pd_bindings.tcl
-proc ::dialog_search::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 ::dialog_search::create_dialog {mytoplevel} {
- global pd_nt
- global linux_wm_hlcolor
- variable searchfont
- variable selected_file
- variable genres [list [_ "All documents"] \
- [_ "Object Help Patches"] \
- [_ "All About Pd"] \
- [_ "Tutorials"] \
- [_ "Manual"] \
- [_ "Uncategorized"] \
- ]
- variable count
- foreach genre $genres {
- lappend count 0
- }
- toplevel $mytoplevel -class [winfo class .]
- wm title $mytoplevel [_ "Search and Browse Documentation"]
- wm geometry $mytoplevel 600x550+0+30
- wm minsize $mytoplevel 230 360
- # tweak: get rid of arrow so the combobox looks like a simple entry widget
- ttk::style configure EntryOut.TCombobox -selectbackground lightgray
- ttk::style configure Entry.TCombobox -selectbackground $linux_wm_hlcolor
- ttk::style configure Genre.TCombobox
- ttk::style configure GenreFocused.TCombobox
- ttk::style map GenreFocused.TCombobox -fieldbackground [list readonly $linux_wm_hlcolor]
- ttk::style configure Search.TButton
- ttk::style configure Search.TCheckbutton
- # widgets
- # for some reason ttk widgets didn't inherit menufont, and this causes tiny
- # fonts on Windows-- so let's hack!
- if {$pd_nt == 1} {
- foreach widget {f.genrebox advancedlabel } {
- option add *[string trim "$mytoplevel.$widget" .]*font menufont
- }
- foreach combobox {searchtextentry f.genrebox} {
- option add *[string trim "$mytoplevel.$combobox" .]*Listbox.font menufont
- }
- }
- #foreach combobox {searchtextentry f.genrebox} {
- # option add *[string trim "$mytoplevel.$combobox" .]*Listbox.selectbackground $linux_wm_hlcolor
- #}
- ttk::frame $mytoplevel.f -padding 3
- ttk::combobox $mytoplevel.f.searchtextentry \
- -textvar ::dialog_search::searchtext \
- -font "$searchfont -12" -style "Entry.TCombobox" -cursor "xterm"
- ttk::button $mytoplevel.f.searchbutton -text [_ "Search"] -takefocus 1 \
- -command ::dialog_search::search -style Search.TButton
- ttk::combobox $mytoplevel.f.genrebox -values $genres -state readonly\
- -style "Genre.TCombobox" -takefocus 1
- $mytoplevel.f.genrebox current 0
- ttk::label $mytoplevel.f.advancedlabel -text [_ "Help"] -foreground $::pd_colors(link) \
- -anchor center -style Foo.TLabel
- text $mytoplevel.navtext -font "$searchfont -12" -height 1 -bd 0 \
- -highlightthickness 0 -bg $::pd_colors(canvas_color) \
- -padx 8 -pady 7 -fg $::pd_colors(text)
- text $mytoplevel.resultstext \
- -yscrollcommand "$mytoplevel.yscrollbar set" \
- -bg $::pd_colors(canvas_color) -fg $::pd_colors(text) \
- -highlightcolor blue -height 30 -wrap word -state disabled \
- -padx 8 -pady 3 -spacing3 2 -bd 0 -highlightthickness 0
- ttk::scrollbar $mytoplevel.yscrollbar -command "$mytoplevel.resultstext yview" \
- -takefocus 0
- ttk::label $mytoplevel.statusbar -text [_ "Pd-L2Ork Search"] -justify left \
- -padding {4 4 4 4}
-
- grid $mytoplevel.f.searchtextentry -column 0 -columnspan 3 -row 0 -padx 2 \
- -pady 2 -sticky ew
- grid $mytoplevel.f.searchbutton -column 3 -columnspan 2 -row 0 -padx 2 -pady 2 \
- -sticky ew
- grid $mytoplevel.f.genrebox -column 0 -columnspan 3 -row 1 -padx 2 -pady 2 -sticky w
- grid $mytoplevel.f.advancedlabel -column 3 -columnspan 2 -row 1 -sticky ew
- grid $mytoplevel.f -column 0 -columnspan 5 -row 0 -sticky ew
- grid $mytoplevel.navtext -column 0 -columnspan 5 -row 2 -sticky nsew
- grid $mytoplevel.resultstext -column 0 -columnspan 4 -row 3 -sticky nsew -ipady 0 -pady 0
- grid $mytoplevel.yscrollbar -column 4 -row 3 -sticky nsew
- grid $mytoplevel.statusbar -column 0 -columnspan 4 -row 4 -sticky nsew
- grid columnconfigure $mytoplevel.f 0 -weight 0
- grid columnconfigure $mytoplevel.f 1 -weight 0
- grid columnconfigure $mytoplevel.f 2 -weight 1
- grid columnconfigure $mytoplevel.f 3 -weight 0
- grid columnconfigure $mytoplevel 0 -weight 1
- grid columnconfigure $mytoplevel 4 -weight 0
- grid rowconfigure $mytoplevel 2 -weight 0
- grid rowconfigure $mytoplevel 3 -weight 1
- # tags
- $mytoplevel.resultstext tag configure hide -elide on
- $mytoplevel.navtext tag configure is_libdir -elide on
- $mytoplevel.resultstext tag configure is_libdir -elide on
- $mytoplevel.resultstext tag configure title -foreground "#0000ff" -underline on \
- -font "$searchfont -12" -spacing1 15
- $mytoplevel.resultstext tag configure dir_title -font "$searchfont -12" \
- -underline on -spacing1 15
- $mytoplevel.resultstext tag configure filename -elide on
- $mytoplevel.navtext tag configure filename -elide on
- $mytoplevel.resultstext tag configure metakey -font "$searchfont -10"
- $mytoplevel.resultstext tag configure metavalue_h -elide on
- $mytoplevel.resultstext tag configure basedir -elide on
- $mytoplevel.navtext tag configure basedir -elide on
- $mytoplevel.resultstext tag configure description -font "$searchfont -12"
- $mytoplevel.resultstext tag configure dt -tabs {5c}
- $mytoplevel.resultstext tag configure spacing -spacing3 4
- $mytoplevel.resultstext tag configure dd -font "$searchfont -12" \
- -lmargin2 5c
- $mytoplevel.resultstext tag configure homepage_title -font "$searchfont -12" \
- -underline on -spacing1 10 -spacing3 5
- $mytoplevel.navtext tag configure homepage_title -underline on
- $mytoplevel.resultstext tag configure homepage_description -font "$searchfont -12" \
- -spacing3 7
- $mytoplevel.resultstext tag configure intro_libdirs -font "$searchfont -12"
- # make tags for both the results and the nav text widgets
- foreach textwidget [list "$mytoplevel.resultstext" "$mytoplevel.navtext"] {
- $textwidget tag configure link -foreground $::pd_colors(link)
- $textwidget tag bind link <Enter> "$textwidget configure \
- -cursor hand2"
- $textwidget tag bind link <Leave> "$textwidget configure \
- -cursor xterm; $mytoplevel.statusbar configure -text \"\""
- $textwidget tag bind intro <Button-1> "::dialog_search::intro \
- $mytoplevel.resultstext"
- $textwidget tag bind intro <Enter> "$mytoplevel.statusbar \
- configure -text \"Go back to the main help page\""
- $textwidget tag bind intro <Leave> "$mytoplevel.statusbar \
- configure -text \"\""
- $textwidget tag bind libdirs <Button-1> "::dialog_search::build_libdirs \
- $mytoplevel.resultstext"
- $textwidget tag bind libdirs <Enter> "$mytoplevel.statusbar configure \
- -text \"Browse all external libraries that have the libdir format\""
- $textwidget tag bind libdirs <Leave> "$mytoplevel.statusbar configure \
- -text \"\""
- }
- # hack to force new <Enter> events for tags and links next to each other
- for {set i 0} {$i<30} {incr i} {
- $mytoplevel.resultstext tag bind "metavalue$i" <Button-1> \
- "::dialog_search::grab_metavalue %x %y $mytoplevel 1"
- $mytoplevel.resultstext tag bind "metavalue$i" <Enter> \
- "::dialog_search::grab_metavalue %x %y $mytoplevel 0"
- $mytoplevel.resultstext tag bind "intro_link$i" <Enter> \
- "::dialog_search::open_file %x %y $mytoplevel resultstext dir 0"
- $mytoplevel.resultstext tag bind "intro_link$i" <Leave> \
- "$mytoplevel.statusbar configure -text \"\""
- $mytoplevel.resultstext tag configure "metavalue$i" -font \
- "$searchfont -12"
- $mytoplevel.resultstext tag configure "intro_link$i" -font \
- "$searchfont -12"
- $mytoplevel.resultstext tag bind "dir_title$i" <Enter> \
- "::dialog_search::open_file %x %y $mytoplevel resultstext dir 0"
- $mytoplevel.resultstext tag bind "dir_title$i" <Leave> \
- "$mytoplevel.resultstext configure -cursor xterm; \
- $mytoplevel.statusbar configure -text \"\""
- $mytoplevel.resultstext tag configure "dir_title$i" \
- -font "$searchfont -12" -underline on -spacing1 15
- }
- # this next tag configure comes after the metavalue stuff above so
- # that it has a higher priority (these are the keywords in the search
- # results)
- $mytoplevel.resultstext tag configure keywords -font "$searchfont -10"
- $mytoplevel.resultstext tag configure homepage_file -font "$searchfont -12"
- $mytoplevel.resultstext tag bind homepage_file <Button-1> "::dialog_search::open_file \
- %x %y $mytoplevel resultstext file 1"
- $mytoplevel.resultstext tag bind homepage_file <Enter> "::dialog_search::open_file \
- %x %y $mytoplevel resultstext file 0"
- $mytoplevel.resultstext tag bind homepage_file <Leave> "$mytoplevel.statusbar configure \
- -text \"\""
- $mytoplevel.resultstext tag bind title <Button-1> "::dialog_search::open_file %x %y \
- $mytoplevel resultstext file 1"
- $mytoplevel.resultstext tag bind title <Enter> "::dialog_search::open_file %x %y \
- $mytoplevel resultstext file 0"
- $mytoplevel.resultstext tag bind dir_title <Enter> "::dialog_search::open_file %x %y \
- $mytoplevel resultstext dir 0"
- $mytoplevel.resultstext tag bind dir_title <Leave> "$mytoplevel.resultstext configure \
- -cursor xterm; $mytoplevel.statusbar configure -text \"\""
- $mytoplevel.resultstext tag bind help_icon <Button-1> "::dialog_search::get_info %x %y \
- $mytoplevel"
- $mytoplevel.resultstext tag bind help_icon <Enter> "$mytoplevel.resultstext configure \
- -cursor hand2; $mytoplevel.statusbar configure -text \"Get info on this object's\
- libdir\""
- $mytoplevel.resultstext tag bind help_icon <Leave> "$mytoplevel.resultstext configure \
- -cursor xterm; $mytoplevel.statusbar configure -text \"\""
- $mytoplevel.resultstext tag bind folder_icon <Button-1> "::dialog_search::open_file %x %y \
- $mytoplevel resultstext dir_in_fm 1"
- $mytoplevel.resultstext tag bind folder_icon <Enter> "::dialog_search::open_file %x %y \
- $mytoplevel resultstext dir_in_fm 0"
- $mytoplevel.resultstext tag bind folder_icon <Leave> "$mytoplevel.resultstext configure \
- -cursor xterm; $mytoplevel.statusbar configure -text \"\""
- foreach textwidget [list "$mytoplevel.resultstext" "$mytoplevel.navtext"] {
- $textwidget tag bind clickable_dir <Button-1> "::dialog_search::click_dir \
- $textwidget %x %y"
- }
- # another workaround: we can't just do a mouseover statusbar update with clickable_dir
- # since it wouldn't register an <Enter> event when moving the mouse from one dir to an
- # adjacent dir. So we have the intro_link$i hack above PLUS a separate binding for navbar
- # links (which are not adjacent)
- $mytoplevel.navtext tag bind navbar_dir <Enter> "::dialog_search::open_file %x %y \
- $mytoplevel navtext dir 0"
- $mytoplevel.navtext tag bind navbar_dir <Leave> "$mytoplevel.statusbar configure \
- -text \"\""
-
- # search window widget bindings
- bind $mytoplevel <$::modifier-equal> "::dialog_search::font_size $mytoplevel.resultstext 1"
- bind $mytoplevel <$::modifier-plus> "::dialog_search::font_size $mytoplevel.resultstext 1"
- bind $mytoplevel <$::modifier-minus> "::dialog_search::font_size $mytoplevel.resultstext 0"
- bind $mytoplevel.f.searchtextentry <Return> "$mytoplevel.f.searchbutton invoke"
- bind $mytoplevel.f.searchtextentry <Key-KP_Enter> "$mytoplevel.f.searchbutton invoke"
- bind $mytoplevel.f.searchtextentry <$::modifier-Key-BackSpace> \
- "::dialog_search::ctrl_bksp $mytoplevel.f.searchtextentry"
- bind $mytoplevel.f.searchtextentry <$::modifier-Key-a> \
- "$mytoplevel.f.searchtextentry selection range 0 end; break"
- bind $mytoplevel.f.searchtextentry <FocusIn> "$mytoplevel.f.searchtextentry configure -style Entry.TCombobox"
- bind $mytoplevel.f.searchtextentry <FocusOut> "$mytoplevel.f.searchtextentry configure -style EntryOut.TCombobox"
- bind $mytoplevel.f.searchbutton <FocusIn> "$mytoplevel.statusbar configure -text \"Search\""
- bind $mytoplevel.f.searchbutton <FocusOut> "$mytoplevel.statusbar configure -text \"\""
- bind $mytoplevel.f.searchbutton <Enter> "$mytoplevel.statusbar configure -text \"Search\""
- bind $mytoplevel.f.searchbutton <Leave> "$mytoplevel.statusbar configure -text \"\""
- bind $mytoplevel.f.genrebox <<ComboboxSelected>> "::dialog_search::filter_results \
- $mytoplevel.f.genrebox $mytoplevel.resultstext"
- bind $mytoplevel.f.genrebox <FocusIn> "$mytoplevel.statusbar configure -text \
- \"Filter the search results by category\"; $mytoplevel.f.genrebox configure -style GenreFocused.TCombobox"
- bind $mytoplevel.f.genrebox <FocusOut> "$mytoplevel.statusbar configure -text \"\"; $mytoplevel.f.genrebox configure -style Genre.TCombobox"
- bind $mytoplevel.f.genrebox <Enter> "$mytoplevel.statusbar configure -text \
- \"Filter the search results by category\""
- bind $mytoplevel.f.genrebox <Leave> "$mytoplevel.statusbar configure -text \"\""
- set advancedlabeltext [_ "Advanced search options"]
- bind $mytoplevel.f.advancedlabel <Enter> "$mytoplevel.f.advancedlabel configure \
- -cursor hand2; $mytoplevel.statusbar configure -text \"$advancedlabeltext\""
- bind $mytoplevel.f.advancedlabel <Leave> "$mytoplevel.f.advancedlabel configure \
- -cursor xterm; $mytoplevel.statusbar configure -text \"\""
- bind $mytoplevel.f.advancedlabel <FocusIn> "$mytoplevel.f.advancedlabel configure \
- -cursor hand2 -text \">Help<\"; $mytoplevel.statusbar configure -text \"$advancedlabeltext\""
- bind $mytoplevel.f.advancedlabel <FocusOut> "$mytoplevel.f.advancedlabel configure \
- -cursor xterm -text \"Help\"; $mytoplevel.statusbar configure -text \"\""
- bind $mytoplevel.f.advancedlabel <Button-1> \
- {menu_doc_open doc/5.reference all_about_finding_objects.pd}
- bind $mytoplevel.f.advancedlabel <Return> \
- {menu_doc_open doc/5.reference all_about_finding_objects.pd}
- # hardcoded this into ::dialog_search namespace from 0.43's
- # pd_bindings.tcl. But really l2ork just needs to use 0.43's
- # API
- ::dialog_search::dialog_bindings $mytoplevel "search"
-# bind $mytoplevel <KeyPress-Escape> "search::cancel $mytoplevel"
-# bind $mytoplevel <KeyPress-Return> "search::ok $mytoplevel"
-# bind $mytoplevel <$::modifier-Key-w> "search::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}
-
- # and redefine "Find" to point to a
- # Firefox style "Find" window bar
- bind $mytoplevel <$::modifier-Key-f> \
- "::dialog_search::toggle_fff_bar $mytoplevel; break"
-
- # Add state and set focus
- if {$::dialog_search::searchtext == ""} {
- $mytoplevel.f.searchtextentry insert 0 [_ "Enter search terms"]
- }
- $mytoplevel.f.searchtextentry selection range 0 end
- # go ahead and set tags for the default genre
- filter_results $mytoplevel.f.genrebox $mytoplevel.resultstext
- focus $mytoplevel.f.searchtextentry
- ::dialog_search::intro $mytoplevel.resultstext
-
- # add default key bindings
- global ctrl_key
- bind $mytoplevel <$ctrl_key-Key-w> [list destroy $mytoplevel]
- bind $mytoplevel <KeyPress-Escape> [list destroy $mytoplevel]
-}
-
-# find_doc_files
-# basedir - the directory to start looking in
-proc ::dialog_search::find_doc_files { basedir } {
- # This is only used for displaying the files in a doc
- # directory
-
- # Fix the directory name, this ensures the directory name is in the
- # native format for the platform and contains a final directory seperator
- set basedir [string trimright [file join $basedir { }]]
- set fileList {}
-
- # Look in the current directory for matching files, -type {f r}
- # means only 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 $helpbrowser::doctypes] {
- lappend fileList $fileName
- }
- return $fileList
-}
-
-proc ::dialog_search::open_file { xpos ypos mytoplevel text type clicked } {
- set textwidget [join [list $mytoplevel $text] .]
- set i [$textwidget index @$xpos,$ypos]
- set range [$textwidget tag nextrange filename $i]
- set filename [eval $textwidget get $range]
- set range [$textwidget tag nextrange basedir $i]
- set basedir [file normalize [eval $textwidget get $range]]
- if {$clicked eq "1"} {
- if {$type eq "file"} {
- menu_doc_open $basedir $filename
- } else {
- menu_doc_open [file dirname [file join $basedir $filename]] {}
- }
- } else {
- $mytoplevel.resultstext configure -cursor hand2
- if {$type eq "file"} {
- $mytoplevel.statusbar configure -text \
- [format [_ "Open %s"] [file join $basedir $filename]]
- } else {
- set msg ""
- if {$type eq "dir_in_fm"} {set msg {in external file browser: }}
- $mytoplevel.statusbar configure -text [format [_ "Browse %s%s"] \
- $msg [file dirname [file join $basedir $filename]]]
- }
- }
-}
-
-# only does keywords for now-- maybe expand this to handle any meta tags
-proc ::dialog_search::grab_metavalue { xpos ypos mytoplevel clicked } {
- set textwidget "$mytoplevel.resultstext"
- set i [$textwidget index @$xpos,$ypos]
- set range [$textwidget tag nextrange metavalue_h $i]
- set value [eval $textwidget get $range]
- set range [$textwidget tag prevrange metakey $i]
- set key [eval $textwidget get $range]
- regsub ":.*" $key {} key
- set key [string tolower $key]
- set value [string tolower $value]
- append text $key ":" $value
- if {$clicked eq "1"} {
- ::dialog_search::searchfor $text
- } else {
- $mytoplevel.statusbar configure \
- -text [format [_ "Search for pattern: %s"] $text]
- }
-}
-
-proc ::dialog_search::searchfor {text} {
- set ::dialog_search::searchtext ""
- set ::dialog_search::searchtext $text
- ::dialog_search::search
-}
-
-
-# show/hide results based on genre
-proc ::dialog_search::filter_results { combobox text } {
- variable genres
- # hack to add the navbar text widget
- foreach text [list "$text" .search.navtext] {
- set elide {}
- if { [$combobox current] eq "0" } {
- foreach genre $genres {
- $text tag configure [join $genre "_"] -elide off
- set tag [join $genre "_"]
- append tag "_count"
- $text tag configure $tag -elide on
- }
- set tag [join [lindex $genres 0] "_"]
- append tag "_count"
- $text tag configure $tag -elide off
- } else {
- foreach genre $genres {
- if { [$combobox get] ne $genre } {
- $text tag configure [join $genre "_"] -elide on
- set tag [join $genre "_"]
- append tag "_count"
- $text tag configure $tag -elide on
- } else {
- $text tag configure [join $genre "_"] -elide off
- set tag [join $genre "_"]
- append tag "_count"
- $text tag configure $tag -elide off
- }
- }
- }
- }
- $combobox selection clear
- focus $text
-}
-
-proc ::dialog_search::readfile {filename} {
- set fp [open $filename]
- set file_contents [read $fp]
- close $fp
- return $file_contents
-}
-
-proc ::dialog_search::search {} {
-# todo: move progressbar stuff to build_index
- variable filelist {}
- variable count {}
- variable genres
- variable doctypes
- variable searchtext
- variable search_history
- variable progress
- variable navbar
- variable i 0
- variable cancelled 0
- variable dbpath
-
- foreach genre $genres {
- lappend count 0
- }
- if {$searchtext eq ""} return
- if { [lsearch $search_history $searchtext] eq "-1" } {
- lappend search_history $searchtext
- .search.f.searchtextentry configure -values $search_history
- }
- .search.f.searchtextentry selection clear
- .search.f.searchtextentry configure \
- -foreground gray -background gray90
- .search.resultstext configure -state normal
- .search.navtext configure -state normal
- .search.resultstext delete 0.0 end
- .search.navtext delete 0.0 end
- set widget .search.navtext
- set navbar {}
-# print_navbar $widget
-
-
- # this is a little tricky-- to keep the gui alive
- # while indexing there is a recursive loop that
- # relies on [after] to allow intermittent gui updates.
- # This means anything following build_index in this
- # function would get called _before_ build_index
- # finishes. So we have to call the search function
- # from within build_index
- if {![file exists $dbpath]} {
-
- set basedirs $::sys_libdir
- set filelist [build_filelist $basedirs $doctypes]
-
- # set up the progressbar
- $widget configure -state normal
- ttk::progressbar $widget.pbar -variable ::dialog_search::progress \
- -mode determinate
- ttk::button $widget.bcancel -text "Cancel" -padding {0 0 0 0} \
- -command "set ::dialog_search::cancelled 1" -cursor left_ptr
- ttk::label $widget.building_index -background white -text " Building index for subsequent searches... "
-# $widget insert 1.end " "
- $widget window create 1.end -window $widget.pbar
- $widget window create 1.end -window $widget.building_index
- $widget window create 1.end -window $widget.bcancel
- $widget configure -state disabled
-
- if {[catch {
- xapian::WritableDatabase database $dbpath $xapian::DB_CREATE_OR_OPEN
- xapian::TermGenerator indexer
- xapian::Stem stemmer "english"
- xapian::Stem nostemmer "none"
- indexer set_stemmer stemmer
- ::dialog_search::build_index
- } exception]} {
- db_error $exception"
- }
- } else {
- do_query
- }
-
- # todo: re-read http://wiki.tcl.tk/1526
-}
-
-
-
-
-
-# findFiles
-# basedirs - the directories to start looking in
-# pattern - A pattern, as defined by the glob command, that the files must match
-proc ::dialog_search::build_filelist {basedirs pattern} {
-
- # Fix the directory name, this ensures the directory name is in the
- # native format for the platform and contains a final directory seperator
- set tmp {}
- foreach directory $basedirs {
- set directory \
- [string trimright [file join [file normalize $directory] { }]]
- lappend tmp $directory
- }
- set basedirs $tmp
-
- # Starting with the passed in directory, do a breadth first search for
- # subdirectories. Avoid cycles by normalizing all file paths and checking
- # for duplicates at each level.
-
- set directories [list]
- set parents $basedirs
- while {[llength $parents] > 0} {
-
- # Find all the children at the current level
- set children [list]
- foreach parent $parents {
- set children [concat $children [glob -nocomplain -type {d r} -path $parent *]]
- }
-
- # Normalize the children
- set length [llength $children]
- for {set i 0} {$i < $length} {incr i} {
- lset children $i [string trimright [file join [file normalize [lindex $children $i]] { }]]
- }
-
- # Make the list of children unique
- set children [lsort -unique $children]
-
- # Find the children that are not duplicates, use them for the next level
- set parents [list]
- foreach child $children {
- if {[lsearch -sorted $directories $child] == -1} {
- lappend parents $child
- }
- }
-
- # Append the next level directories to the complete list
- set directories [lsort -unique [concat $directories $parents]]
- }
-
- # Get all the files in the passed in directory and all its subdirectories
- set result [list]
- foreach directory $directories {
- set result [concat $result \
- [glob -nocomplain -type {f r} -path $directory -- $pattern]]
- }
-
- # Normalize the filenames
- set length [llength $result]
- for {set i 0} {$i < $length} {incr i} {
- lset result $i [file normalize [lindex $result $i]]
- }
-
- # Return only unique filenames
- return [lsort -unique $result]
-}
-
-proc ::dialog_search::destroy_progressbar {widget} {
- if {[lsearch [$widget window names] .search.navtext.pbar] != -1} {
- $widget delete .search.navtext.pbar end
- }
-}
-
-proc ::dialog_search::results_epilog {widget doccount} {
-# todo: move $widget delete to index building
- variable genres
- variable count
- variable filelist
- .search.f.searchtextentry configure -foreground black -background white
- $widget configure -state normal
- destroy_progressbar $widget
- print_navbar $widget
-# todo: clean up setting of widget state
- set window [winfo parent $widget]
- $widget tag configure navbar -tabs [list \
- [expr {[winfo width $window]/2.0}] center]
- $widget configure -state normal
- # hack with whitespace to simulate centered text.
- $widget insert 1.end [_ "\tFound "] "navbar"
- set i 0
- foreach genre $genres {
- set tag [join $genre "_"]
- append tag "_count"
- $widget insert 1.end [lindex $count $i] "$tag navbar"
- incr i
- }
- $widget insert 1.end " " "navbar"
- $widget insert 1.end \
- [format [_ "out of %s docs"] $doccount] "navbar"
- $widget configure -state disabled
- .search.resultstext configure -state disabled
-}
-
-proc ::dialog_search::db_error {exception} {
- ::pdwindow::error "Search error: $exception\n"
-}
-
-proc ::dialog_search::get_pdfinfo {docfile} {
- set data ""
- switch -exact [file tail $docfile] {
- rradicalpd.pdf {
- append data "description collection of patches that make Pd \
- easier and faster to use for people who are more used to \
- software like Reason or Reaktor;\n"
- append data "author Frank Barknecht;\n"
- }
- GemPrimer.pdf {
- append data "description introduction to Gem, a pdf manual for \
- the Graphics Environment for Multimedia;\n"
- append data "author Johannes Zmoelnig;\n"
- }
- pattHiro.pdf {
- append data "description just a single-page pdf \
- document with the word \"Hiro\" printed in a rectangle;\n"
- append data "author Patt Hiro;\n"
- }
- pmpd.pdf {
- append data "description pdf manual for the physical modelling \
- library for pd;\n"
- append data "author Cyrille Henry;\n"
- }
- Dokumentation_German.pdf {
- append data "description Funktionsbeschreibung der Pd-Objekte \
- von iemlib1, iemlib2 und iemabs (pdf);\n"
- }
- vst~.pdf {
- append data "description pdf manual for Pd external that acts as a \
- VST2.0 host;\n"
- append data "author Marius Schebella;\n"
- }
- readme.pdf {
- append data "description brief pdf manual for an abstraction \
- cloning external;\n"
- append data "author Olaf Matthes;\n"
- }
- adapt_filt_lib.pdf {
- append data "description pdf manual for Pd external library \
- containing several algorithms for least mean square (LMS) \
- adaptive filtering;\n"
- append data "author Markus Noisternig and Thomas Musil;\n"
- }
- }
- return $data
-}
-
-proc ::dialog_search::parse_meta_subpatch {file_contents gemhelp} {
- set data ""
- if {$gemhelp} {
- # description(:) comment somewhere within the patch...
- append data "description [get_metadata description $file_contents];\n"
-# set desc [get_metadata description $file_contents]
-# if {$desc ne ""} {append data "description $desc;\n"}
- } else {
- set meta_subpatch ""
- regexp -nocase {#N canvas [0-9]+ [0-9]+ [0-9]+ [0-9]+ meta [0-9];\n(.*?)#X restore [0-9]+ [0-9]+ pd meta;} $file_contents - meta_subpatch
- if {$meta_subpatch ne ""} {
- foreach {key prefix} $::dialog_search::metakeys {
- append data "$key [get_metadata $key $meta_subpatch];\n"
-# set values [get_metadata $key $meta_subpatch]
-# if {$values ne ""} {append data "$key $values;\n"}
- }
- }
- }
- return $data
-}
-
-proc ::dialog_search::parse_gemhelp {file_contents} {
- # floating description(:) comment in a patch...
- set desc ""
- regexp -nocase {#X text [0-9]+ [0-9]+ description:? ([^;]*?);\n} $file_contents - desc
- if {$desc ne ""} {
- regsub {\n} $desc {} desc
- regsub { \\,} $desc {,} desc
- return "description $desc;\n"} else {return ""}
-}
-
-# Recursive loop to index all files and keep the gui
-# alive every 64 iterations. This was tested searching
-# a little over 9,000 docs and seems to work alright
-proc ::dialog_search::build_index {} {
- variable database
- variable dbpath
- variable filelist
- variable progress
- variable i
- variable cancelled
- set obj {}
- set file_contents {}
- if { $i < [llength $filelist]} {
- # get index of docfile docname and basedir
- set docfile [lindex $filelist $i]
- append data "path $docfile;\n"
-
- # Since there are only eight pdf manuals in pd svn,
- # it's a waste of time to build or hook into a pdf
- # parser. Instead there's just some hardcoded metadata
- # so people can find what already exists. Going forward
- # it's better to use pd files or, if necessary, html.
- if {[file extension $docfile] eq ".pdf"} {
- set file_contents [get_pdfinfo $docfile]
- append data $file_contents
- } else {
- # for everything else we need to read the actual file
- set file_contents [readfile $docfile]
- }
- if {[file extension $docfile] eq ".pd"} {
- append data [parse_meta_subpatch $file_contents \
- [regexp -nocase -- {gem(?:.*?)-help} $docfile]]
- set temp ""
- foreach line [split $file_contents "\n"] {
- if {[regexp {#X connect} $line]} {
- } elseif {[regexp {#X obj [0-9]+ [0-9]+ (.*)} $line - line]} {
- append temp "obj $line"
- lappend obj [regsub {^([^[:space:];]+).*;?} $line {\1}]
- } elseif {[regexp {#X (\m\S+\M) [0-9]+ [0-9]+ (.*)} \
- $line - sel line]} {
- append temp "$sel $line"
- } elseif {![regexp {^(?:#\S )} $line]} {
- append temp $line
- }
- }
- set file_contents $temp
- } elseif {[file extension $docfile] eq ".htm" ||
- [file extension $docfile] eq ".html"} {
- set description ""
- # title should exist if the doc is worth a damn...
- regexp {<title>(.*)</title>} $file_contents - description
- if {$description ne ""} {
- append data "description $description;\n"
- }
- }
-
- if {[catch {
- # todo: break this out and clean up
-
- xapian::Document doc
- doc set_data $data
- indexer set_document doc
- indexer set_stemmer stemmer
- indexer index_text $file_contents
- indexer set_stemmer nostemmer
- foreach {key prefix} $::dialog_search::metakeys {
- set values ""
- regexp "$key \(.*?);" $data - values
- if {$values ne ""} {indexer index_text $values 1 $prefix}
- }
- # add all object instances, both prefixed and unprefixed.
- # add_term doesn't include positional info-- could use the
- # x,y coords for that...
- if {$obj ne ""} {
- foreach word $obj {
- doc add_term [string tolower $word]
- doc add_term [format XO%s [string tolower $word]]
- }
- }
- # file name and extension
- indexer index_text $docfile 100
- doc add_term [format XF%s [string tolower [file tail $docfile]]]
- indexer index_text $docfile 100
- doc add_term [format E%s [string tolower [file extension $docfile]]]
-
- database add_document doc
- } exception]} {
- db_error $exception
- }
- incr i
- # I changed '64' below to [llength $filelist]/8 in order
- # to keep the updates to 8 total regardless of the number
- # of files and tcl complained there were too many nested
- # loops. Hm...
- if { $i%64==0 } {
- # if the user closed the window then quit searching. I'm
- # using a global variable here in case we want to veer from
- # the standard dialog behavior and stop a search with ESC
- # without actually withdrawing the window
- if { $cancelled == 0 } {
- # update the progressbar variable and refresh gui
- set progress [expr $i*100.0/[llength $filelist]]
- after idle ::dialog_search::build_index
- } else {
- if {[catch { database -delete } exception]} {
- db_error $exception
- }
- file delete -force $dbpath
- .search.navtext configure -state normal
- destroy_progressbar ".search.navtext"
- print_navbar .search.navtext
- # todo: manage widget state better
- .search.navtext configure -state normal
- .search.navtext insert end \
- " Cancelled building the index."
- .search.f.searchtextentry configure -state normal
- .search.f.searchtextentry configure -foreground black \
- -background white
- .search.navtext configure -state disabled
- .search.resultstext configure -state disabled
- return
- }
- } else { ::dialog_search::build_index }
- } else {
- # we've gone throught the whole filelist so end the recursion
- set progress 100
-# ::dialog_search::results_epilog ".search.navtext"
- database -delete
- do_query
- return
- }
-}
-
-proc ::dialog_search::do_query {} {
- variable database
- variable dbpath
- variable searchtext
- set doccount 0
-
- if {[catch {
- xapian::Database database $dbpath
- set doccount [database get_doccount]
-
- # Start an enquire session.
- xapian::Enquire enquire database
-
- xapian::QueryParser qp
- xapian::Stem stemmer "english"
- foreach {key prefix} $::dialog_search::metakeys {
- qp add_boolean_prefix $key $prefix
- }
- qp add_boolean_prefix object XO
- qp add_boolean_prefix filename XF
- qp add_boolean_prefix extension E
- qp set_stemmer stemmer
- qp set_database database
- qp set_stemming_strategy $xapian::QueryParser_STEM_SOME
- set query [qp parse_query $searchtext]
- } exception]} {
- db_error $exception
- results_epilog .search.navtext 0
- return
- }
- if {[catch {
- pdtk_post "Parsed query is: [$query get_description]\n"
-
- # Find the top 1337 results for the query.
- enquire set_query $query
- set matches [enquire get_mset 0 1337]
-
- # Display the results.
- # pdtk_post "[$matches get_matches_estimated] results found:"
- } exception]} {
- db_error $exception
- }
- for {set i [$matches begin]} {![$i equals [$matches end]]} {$i next} {
- if {[catch {
- xapian::Document document [$i get_document]
- set data [document get_data]
- } exception]} {
- db_error $exception
- break
- }
-# set rank [expr [$i get_rank] + 1]
-# pdtk_post "[format {%s: %s%% docid=%s} \
-# $rank [$i get_percent] [$i get_docid]]\n"
-# pdtk_post "[document get_data]\n\n\n"
- regexp {path (.*?);\n} $data - path
- set filename [file tail $path]
- set basedir [file dirname $path]
- printresult $filename $basedir $data .search.resultstext 1
- }
- results_epilog .search.navtext $doccount
-}
-
-# put license.txt and readme.txt at the bottom of a directory listing
-proc ::dialog_search::directory_sort { list } {
- if {$list eq ""} {return}
- foreach name $list {
- regsub -nocase {(license\.txt|readme\.txt)} $name {~~~\1} key
- lappend list2 [list $key $name]
- }
- foreach pair [lsort -index 0 -dictionary $list2] {
- lappend list3 [lindex $pair 1]
- }
- return $list3
-}
-
-# path of least resistance to give Pd manual a description
-proc ::pdmanual_description {filename} {
- set desc {}
- switch -exact $filename {
- 1.introduction.txt {set desc {This opens when you click the \
- "Help" menu and choose "About Pd"}}
- index.htm {set desc "Pd Documentation: Table of Contents" }
- x1.htm { set desc "Pd Documentation Chapter 1: Introduction"}
- x2.htm { set desc "Pd Documentation Chapter 2: Theory of Operation" }
- x3.htm { set desc "Pd Documentation Chapter 3: Getting Pd to Run" }
- x4.htm { set desc "Pd Documentation Chapter 4: Writing Pd Objects in C" }
- x5.htm { set desc "Pd Documentation Chapter 5: Current Status of the Software" }
- }
- return $desc
-}
-
-proc ::dialog_search::libdirize {filename basedir} {
- # if a pd *-help.pd file isn't in a directory that
- # has a *-meta.pd patch, we don't list it as a libdir doc
- if {[glob -nocomplain [file join $basedir *-meta.pd]] eq ""} {
- return [list $basedir $filename]
- }
- set libdir [file tail $basedir]
- set outfile [file join $libdir $filename]
- # the following command uses tcl's argument expansion (the
- # cryptic {*} thingy). That it is one of the ugliest parts
- # of the language I've encountered in tcl is saying a lot :)
- set outdir [file join {*}[lrange [file split $basedir] 0 end-1]]
- return [list $outdir $outfile]
-}
-
-proc ::dialog_search::printresult {filename basedir metadata widget mixed_dirs} {
- variable count
- variable genres
- set description ""
- set keywords ""
- set genre ""
- set title ""
- if {[regexp -nocase -- ".*-help\.pd" $filename]} {
- # object help
- # show libdir prefix in the search results
- if {$mixed_dirs} {
- set tmplist [libdirize $filename $basedir]
- set basedir [lindex $tmplist 0]
- set filename [lindex $tmplist 1]
- }
- set genre 1
- regsub -nocase -- "(?:^|(?:5.reference/))(.*)-help.pd" $filename {\1} title
- } elseif {[regexp -nocase -- "all_about_.*\.pd" $filename]} {
- regsub -nocase -- {(?:.*[/\\])?(.*)\.pd} $filename {\1} title
- regsub -all -- "_" $title " " title
- # all about pd
- set genre 2
- } elseif {[file extension $filename] eq ".html" ||
- [file extension $filename] eq ".htm" ||
- [file extension $filename] eq ".pdf"} {
- set title $filename
- # Pd Manual (or some html page in the docs)
- if {[file tail $basedir] eq "1.manual"} {
- set description [pdmanual_description $filename]
- }
- set genre 4
- } else {
- set title $filename
- if {[file tail $basedir] eq "1.manual"} {
- set description [pdmanual_description $filename]
- }
- }
- if {[regexp -nocase {license\.txt} $filename]} {
- set description [concat [_ "text of the license for"] \
- [file tail $basedir]]
- } elseif {[regexp -nocase {readme\.txt} $filename]} {
- set description [concat [_ "general information from the author of"] [file tail $basedir]]
- } else {
- regexp -nocase -- {description (.*?);\n} $metadata -> description
- }
- regexp -nocase -- {keywords (.*?);\n} $metadata -> keywords
- if {[regexp -nocase -- {genre tutorial;\n} $metadata]} {
- set genre 3
- }
- if { $genre eq "" } {
- set genre 5
- }
- lset count $genre [expr [lindex $count $genre] + 1]
- set genre_name [join [lindex $genres $genre] "_"]
- lset count 0 [expr [lindex $count 0] + 1]
- # print out an entry for the file
- $widget insert end "$title" "title link $genre_name"
- if {$mixed_dirs} {
- if { $genre == 1 } {
- $widget insert end " "
- $widget image create end -image ::dialog_search::help
- }
- $widget insert end " "
- $widget image create end -image ::dialog_search::folder
- if { $genre == 1 } {
- $widget tag add help_icon "end -4indices" "end -3indices"
- $widget tag add $genre_name "end -5indices" end
- } else {
- $widget tag add $genre_name "end -3indices" end
- }
- $widget tag add folder_icon "end -2indices" "end -1indices"
- }
- $widget insert end "$basedir" basedir
- $widget insert end "$filename" filename
- if { $description eq "" } {
- set description [_ "No DESCRIPTION tag."]
- }
- $widget insert end "\n$description\n" "description $genre_name"
- if { $keywords ne "" } {
- $widget insert end [_ "Keywords:"] "metakey $genre_name"
- set i 0
- foreach value $keywords {
- set metavalue "metavalue$i"
- set i [expr {($i+1)%30}]
- $widget insert end " " "link $genre_name"
- $widget insert end $value "$metavalue keywords link $genre_name"
- # have to make an elided copy for use with "nextrange"
- # since I can't just get the tag's index underneath
- # the damn cursor!!!
- $widget insert end $value metavalue_h
- }
- $widget insert end "\n" $genre_name
- }
-}
-
-proc ::dialog_search::get_metadata {field file_contents} {
- # todo: make regexp match only unescaped semicolon
- set data ""
- regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ $field\[:\]? (\[^;\]*?);.*" $file_contents -> data
- regsub -all {[{}\\]} $data {} data
- regsub -all {\n} $data { } data
- regsub -all { ,} $data {,} data
- return $data
-}
-
-proc ::dialog_search::ok {mytoplevel} {
- # this is a placeholder for the standard dialog bindings
-}
-
-proc ::dialog_search::cancel {mytoplevel} {
- variable cancelled 1
- wm withdraw .search
-}
-
-
-# hack to select all because tk's default bindings apparently
-# assume the user is going to want emacs shortcuts
-proc ::dialog_search::sa { widget } {
- $widget selection range 0 end
- break
-}
-
-proc ::dialog_search::intro { t } {
- variable navbar {}
- .search.navtext configure -state normal
- .search.navtext delete 0.0 end
- .search.navtext insert end [_ "Search"] "navbar homepage_title"
- .search.navtext configure -state disabled
- $t configure -state normal
- $t delete 0.0 end
- $t insert end \
- [_ "Enter terms above. Use the dropdown menu to filter by category."] \
- homepage_description
- $t insert end "\n"
-
-
- $t insert end [_ "Introductory Topics"] homepage_title
- $t insert end "\n"
-
-
- set intro_docs [list \
- [_ "Pd Manual"] 1.manual [_ "HTML manual for Pure Data"] \
- [_ "Control Structure"] 2.control.examples \
- [_ "tutorials for control objects"] \
- [_ "Audio Signals"] 3.audio.examples [_ "tutorials for audio signals"] \
- ]
- set i 1
- foreach {title dir desc} $intro_docs {
- $t insert end "$title" "link clickable_dir intro_link$i spacing dt"
- $t insert end [file join $::sys_libdir doc $dir] basedir
- $t insert end "0" is_libdir
- $t insert end "dummy" filename
- $t insert end "\t$desc\n" dd
- set i [expr {($i+1)%30}]
- }
- $t insert end [_ "All About Pd"] "link homepage_file spacing"
- $t insert end [file join $::sys_libdir doc 5.reference] basedir
- $t insert end all_about.pd filename
- $t insert end " " description
- $t insert end \
- [join [list \t [_ "reference patches for key concepts and settings in Pd"]] ""] \
- "description dd"
- $t insert end "\n"
-
- $t insert end [_ "Advanced Topics"] homepage_title
- $t insert end "\n"
- set advanced_docs [list \
- [_ "Networking"] [file join manuals 3.Networking] \
- [_ "sending data over networks with Pd"] \
- [_ "Writing Externals"] 6.externs \
- [_ "how to code control and signal objects in C"] \
- [_ "Data Structures"] 4.data.structures \
- [_ "creating graphical objects in Pure Data"] \
- [_ "Dynamic Patching"] [file join manuals pd-msg] \
- [_ "programmatically create/destroy Pd objects"] \
- [_ "Implementation Details"] [file join manuals Pd] \
- [_ "file format specification, license text, etc."]
- ]
- set i 0
- foreach {title dir desc} $advanced_docs {
- $t insert end "$title" "link clickable_dir intro_link$i spacing dt"
- $t insert end [file join $::sys_libdir doc $dir] basedir
- $t insert end "0" is_libdir
- $t insert end "dummy" filename
- $t insert end "\t$desc\n" "description dd"
- set i [expr {($i+1)%30}]
- }
-
- $t insert end [_ "Browse the Documentation"] homepage_title
- $t insert end "\n"
- $t insert end [_ "The \"doc\" directory"] \
- "link clickable_dir intro_link0 spacing"
- $t insert end [file join $::sys_libdir doc] basedir
- $t insert end "0" is_libdir
- $t insert end "\n"
- $t insert end [_ "External Pd libraries"] \
- "link libdirs intro_libdirs spacing"
- $t insert end "\n"
- $t insert end [_ "Pure Data Glossary"] "link homepage_file spacing"
- $t insert end [file join $::sys_libdir doc 5.reference] basedir
- $t insert end glossary.pd filename
- $t insert end "\n"
-
- $t insert end [_ "Object Categories"] homepage_title
- $t insert end "\n"
- $t insert end \
- [_ "Many documents are categorized using a keyword field. Click\
- a link below to find all documents marked with that keyword."] \
- homepage_description
- $t insert end "\n"
-
- set keywords [list \
- abstraction [_ "abstraction"] \
- [_ "object itself is written in Pure Data"] \
- abstraction_op [_ "abstraction_op"] \
- [_ "object's behavior only makes sense inside an abstraction"] \
- analysis [_ "analysis"] [_ "analyze the incoming signal or value"] \
- anything_op [_ "anything_op"] \
- [_ "store or manipulate any type of data"] \
- array [_ "array"] [_ "create or manipulate an array"] \
- bandlimited [_ "bandlimited"] \
- [_ "object describes itself as being bandlimited"] \
- block_oriented [_ "block_oriented"] \
- [_ "signal object that performs block-wide operations (as opposed \
- to repeating the same operation for each sample of the block)"] \
- canvas_op [_ "canvas_op"] \
- [_ "object's behavior only makes sense in context of a canvas"] \
- control [_ "control"] [_ "control rate objects"] \
- conversion [_ "conversion"] \
- [_ "convert from one set of units to another"] \
- data_structure [_ "data_structure"] \
- [_ "create or manage data structures"] \
- dynamic_patching [_ "dynamic_patching"] \
- [_ "dynamic instantiation/deletion of objects or patches"] \
- filesystem [_ "filesystem"] \
- [_ "object that reads from and/or writes to the file system"] \
- filter [_ "filter"] [_ "object that filters incoming data"] \
- GUI [_ "GUI"] [_ "graphical user interface"] \
- list_op [_ "list_op"] \
- [_ "object that manipulates, outputs, or stores a list"] \
- MIDI [_ "MIDI"] \
- [_ "object that provides MIDI functionality"] \
- network [_ "network"] \
- [_ "provides access to or sends/receives data over a network"] \
- nonlocal [_ "nonlocal"] \
- [_ "pass messages or data without patch wires"] \
- orphan [_ "orphan"] [_ "help patches that cannot be accessed by \
- right-clicking \"help\" for the corresponding object"] \
- patchfile_op [_ "patchfile_op"] [_ "object whose behavior only \
- makes sense in terms of a Pure Data patch"] \
- pd_op [_ "pd_op"] \
- [_ "object that can report on or manipulate global data\
- associated with the running instance of Pd"] \
- ramp [_ "ramp"] [_ "fills in between a starting and ending value"] \
- random [_ "random"] \
- [_ "output a random value, list, signal, or other random data"] \
- signal [_ "signal"] \
- [_ "audiorate object (so called \"tilde\" object)"] \
- soundfile [_ "soundfile"] [_ "object that can play, manipulate, \
- and/or save a sound file (wav, ogg, flac, mp3, etc.)"] \
- storage [_ "storage"] [_ "object whose main purpose is to store data"] \
- symbol_op [_ "symbol_op"] [_ "manipulate or store a symbol"] \
- time [_ "time"] [_ "measure and/or manipulate time"] \
- trigonometry [_ "trigonometry"] \
- [_ "provide trigonometric functionality"] \
- ]
-
- set i 0
- foreach {keyword name desc} $keywords {
- $t insert end "keywords" "metakey hide spacing"
- $t insert end $name "metavalue$i link dt"
- $t insert end $keyword metavalue_h
- $t insert end "\t$desc\n" dd
- set i [expr {($i+1)%30}]
- }
- $t configure -state disabled
-}
-
-# hack to get <ctrl-backspace> to delete the word to the left of the cursor
-proc ::dialog_search::ctrl_bksp {mytoplevel} {
- set last [$mytoplevel index insert]
- set first $last
- while { $first > 0 } {
- set char [string index [$mytoplevel get] $first-1]
- set prev [string index [$mytoplevel get] $first]
- if { [regexp {[[:punct:][:space:]\|\^\~\`]} $char] &&
- $first < $last &&
- [regexp {[^[:punct:][:space:]\|\^\~\`]} $prev] ||
- [$mytoplevel selection present] } { break }
- incr first -1
- }
- incr first
- $mytoplevel delete $first $last
-}
-
-proc ::dialog_search::font_size {text direction} {
- variable searchfont
- set offset {}
- set min_fontsize -8
- if {$direction == 1} {
- set offset -2
- } else {
- set offset 2
- }
- set update 1
- foreach tag [$text tag names] {
- set val [$text tag cget $tag -font]
- if {[string is digit -strict [lindex $val 1]] &&
- [expr {[lindex $val 1]+$offset}] > $min_fontsize} {
- set update 0
- }
- }
- if {$update} {
- foreach tag [$text tag names] {
- set val [$text tag cget $tag -font]
- if {[string is ascii -strict [lindex $val 1]]} {
- $text tag configure $tag -font "$searchfont \
- [expr {min([lindex $val 1]+$offset,$min_fontsize)}]"
- }
- }
- }
-}
-
-proc ::dialog_search::build_libdirs {textwidget} {
- set libdirs {}
- foreach pathdir [file join $::sys_libdir extra] {
- 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 separator
- set dir [string trimright [file join [file normalize $pathdir] { }]]
- # find the libdirs
- foreach filename [glob -nocomplain -type d -path $dir "*"] {
- # use [file tail $filename] to get the name of libdir
- set dirname [file tail $filename]
- set norm_filename [string trimright \
- [file join [file normalize $filename] { }]]
- if {[glob -nocomplain -type f -path $norm_filename \
- "$dirname-meta.pd"] ne ""} {
- lappend libdirs [list "$norm_filename" "$dirname"]
- }
- }
- }
- ::dialog_search::print_libdirs $textwidget $libdirs
-}
-
-proc ::dialog_search::print_libdirs {textwidget libdirs} {
- variable navbar
- $textwidget configure -state normal
- $textwidget delete 0.0 end
- set navbar [list [list [_ "External libraries"] "link libdirs navbar" {}]]
- print_navbar $textwidget
- # now clear out the navbar and then add "externals (flag) to it..."
- set i 0
- foreach libdir [lsort $libdirs] {
- set i [expr {($i+1)%30}]
- set description {}
- set author {}
- $textwidget insert end "[lindex $libdir 1]" \
- "link clickable_dir dir_title$i"
- $textwidget insert end " "
- $textwidget image create end -image ::dialog_search::folder
- $textwidget tag add folder_icon "end -2indices" "end -1indices"
- $textwidget insert end "[lindex $libdir 0]" basedir
- $textwidget insert end "dummy" filename
- $textwidget insert end "1" is_libdir
- $textwidget insert end "\n"
- set file_contents [readfile [format %s%s [join $libdir ""] "-meta.pd"]]
- regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ description\[:\]? (.*?);.*" [join $file_contents] -> description
- if {$description ne {}} {
- regsub -all { \\,} $description {,} description
- $textwidget insert end "$description\n" description
- } else {
- $textwidget insert end [_ "no DESCRIPTION tag or values."] \
- description
- $textwidget insert end "\n"
- }
- foreach tag {Author License Version} {
- if {[regexp -nocase -- "#X text \[0-9\]+ \[0-9\]+ $tag (.*?);.*" \
- [join $file_contents] -> values]} {
- $textwidget insert end [format "%s: " $tag] metakey
- if {$values ne {}} {
- regsub -all { \\,} $values {,} values
- $textwidget insert end "$values" metakey
- } else {
- $textwidget insert end \
- "no [string toupper $tag] tag or values." metakey
- }
- $textwidget insert end "\n"
- }
- }
- }
- $textwidget configure -state disabled
-}
-
-proc ::dialog_search::click_dir {textwidget xpos ypos} {
- set i [$textwidget index @$xpos,$ypos]
- set range [$textwidget tag nextrange basedir $i]
- set dir [eval $textwidget get $range]
- set range [$textwidget tag nextrange is_libdir $i]
- set is_libdir [eval $textwidget get $range]
- build_subdir .search.resultstext $dir $is_libdir
-}
-
-proc ::dialog_search::build_subdir {textwidget dir is_libdir} {
- variable navbar
- if {[lsearch -exact [join $navbar] $dir] == -1} {
- lappend navbar [list "$dir" "link clickable_dir navbar navbar_dir" "subdir"]
- } else {
- set newnav {}
- foreach {entry} $navbar {
- lappend newnav $entry
- if {[lindex $entry 0] eq $dir} {break}
- }
- set navbar $newnav
- }
- $textwidget configure -state normal
- $textwidget delete 0.0 end
- print_navbar .search.navtext
- # get any subdirs first
- set i 0
- foreach subdir \
- [lsort -dictionary [glob -nocomplain -type d -directory $dir "*"]] {
- # get name of subdir
- set subdirname [file tail $subdir]
- $textwidget insert end "$subdirname" "link clickable_dir dir_title$i"
- set norm_subdir \
- [string trimright [file join [file normalize $subdir] { }]]
- $textwidget insert end "0" is_libdir
- $textwidget insert end " "
- $textwidget image create end -image ::dialog_search::folder
- $textwidget tag add folder_icon "end -2indices" "end -1indices"
- $textwidget insert end "$norm_subdir" basedir
- $textwidget insert end "dummy" filename
- $textwidget insert end "\n"
- set i [expr {($i+1)%30}]
- }
- foreach docfile [directory_sort [find_doc_files [file normalize $dir]]] {
- # get name of file
- # if we're in a libdir, filter out pd patches that don't end in -help.pd
- if {[regexp {.*-help\.pd$} $docfile] ||
- [string replace $docfile 0 [expr [string length $docfile] - 4]] \
- ne ".pd" ||
- !$is_libdir} {
- set docname [string replace $docfile 0 \
- [string length [file normalize $dir]]]
- set file_contents [readfile $docfile]
- if {[file extension $docfile] eq ".pd"} {
- set file_contents [parse_meta_subpatch $file_contents \
- [regexp -nocase -- {gem(?:.*?)-help} $docfile]]
- }
- ::dialog_search::printresult \
- $docname $dir $file_contents $textwidget 0
- }
- }
- $textwidget configure -state disabled
-}
-
-# fix this-- maybe print_navbar shouldn't need an argument
-proc ::dialog_search::print_navbar {foo} {
- variable navbar
- set separator /
- set text .search.navtext
- $text configure -state normal
- $text delete 1.0 end
- $text insert 1.0 [_ "Home"] "link intro navbar"
- if {[llength $navbar] == 0} {
- $text configure -state disabled
- return
- }
- for {set i 0} {$i<[expr {[llength $navbar]-1}]} {incr i} {
- $text insert 1.end " $separator " navbar
- if {[lindex $navbar $i 2] eq "subdir"} {
- $text insert 1.end [file tail [lindex $navbar $i 0]] \
- [lindex $navbar $i 1]
- $text insert 1.end [lindex $navbar $i 0] basedir
- $text insert 1.end dummy filename
- $text insert 1.end "0" is_libdir
- } else {
- $text insert 1.end [lindex $navbar $i 0] [lindex $navbar $i 1]
- }
- }
- if {[lindex $navbar end 2] eq "subdir"} {
- $text insert 1.end " $separator " navbar
- $text insert 1.end [file tail [lindex $navbar end 0]]
- } else {
- $text insert 1.end " $separator " navbar
- $text insert 1.end [lindex $navbar end 0]
- }
- $text configure -state disabled
-}
-
-proc ::dialog_search::get_info {xpos ypos mytoplevel} {
- set textwidget "$mytoplevel.resultstext"
- set i [$textwidget index @$xpos,$ypos]
- set range [$textwidget tag nextrange filename $i]
- set filename [eval $textwidget get $range]
- set range [$textwidget tag nextrange basedir $i]
- set basedir [file normalize [eval $textwidget get $range]]
- set match 0
- set fulldir [file dirname [file join $basedir $filename]]
- set meta [format "%s-meta.pd" [file tail $fulldir]]
- if {[regexp {5.reference} $fulldir]} {
- tk_messageBox -message {Internal Object} \
- -detail [_ "This help patch is for an internal Pd class"] \
- -parent $mytoplevel -title [_ "Search"]
- set match 1
- } else {
- # check for a readme file (use libname-meta.pd as a last resort)
- foreach docname [list Readme.txt README.txt readme.txt README $meta] {
- if {[file exists [file join $fulldir $docname]]} {
- menu_doc_open $fulldir $docname
- set match 1
- break
- }
- }
- }
- if {!$match} {
- tk_messageBox -message \
- [_ "Sorry, can't find a README file for this object's library."] \
- -title [_ "Search"]
- }
-}
-
-# create the menu item on load
-# set mymenu .menubar.help
- # this can be buggy with translated text
- #set inserthere [$mymenu index [_ "Report a bug"]]
-#if {$::windowingsystem eq "aqua"} {
-# set inserthere 3
-#} else {
-# set inserthere 4
-#}
-# $mymenu insert $inserthere separator
-# $mymenu insert $inserthere command -label [_ "Search"] \
-# -command {::dialog_search::open_helpbrowser .search}
-# Note: you can't use <command-h> on OSX because it's a
-# window binding
-# bind all <$::modifier-Key-h> \
-# {::dialog_search::open_helpbrowser .search}
-
-# Folder icon "folder16"
-# from kde klassic icons (license says GPL/LGPL)
-
-image create photo ::dialog_search::folder -data {
- R0lGODlhEAAQAIMAAPwCBNSeBJxmBPz+nMzOZPz+zPzSBPz2nPzqnAAAAAAA
- AAAAAAAAAAAAAAAAAAAAACH5BAEAAAAALAAAAAAQABAAAARFEMhJ6wwYC3uH
- 98FmBURpElkmBUXrvsVgbOxw3F8+A+zt/7ddDwgUFohFWgGB9BmZzcMTASUK
- DdisNisSeL9gMGdMJvsjACH+aENyZWF0ZWQgYnkgQk1QVG9HSUYgUHJvIHZl
- cnNpb24gMi41DQqpIERldmVsQ29yIDE5OTcsMTk5OC4gQWxsIHJpZ2h0cyBy
- ZXNlcnZlZC4NCmh0dHA6Ly93d3cuZGV2ZWxjb3IuY29tADs=
-}
-
-# Info icon "acthelp16"
-# from kde slick icons (license says GPL/LGPL)
-
-image create photo ::dialog_search::help -data {
-R0lGODlhEAAQAMZoAAAZUgAcVAAnXAAnXQAoZAAraCZPhCBSiiRVjC9dkjhclTtk
-oTxllV9/p2aCsHCMuHWQuHqUvXmYxYCZwIadwoKeyIeewoOfyYWfxYmfw4yhxIik
-zI6jxZCkxoqmzZKmx4+s0pCs0pSv06S3zKK31aO41qS41qW62Km92K/E37PH4LTI
-4bnJ4b3J3bvK4sLQ5snX6cvZ683Z7c7Z7M3a7NHb7c/c7dHd7dLd7dLe7tXe7tXg
-8tbh8dfh79fh8Nji79ji8Nnj8Nrj8Nzl8d/n8+Lp9OPq9Obs9eft9ubt+ejt9ufu
-+enu9ujv+uvw9+3x+u7y+O/z+fDz+fH0+fH0+vL1+vH1/fL1/fP2+vX3+/b4/Pb5
-/Pf5/Pf6/fj6/fj6//n6/fn7/fv8/fv8/v39/v3+/v7+/v7+////////////////
-////////////////////////////////////////////////////////////////
-/////////////////yH5BAEKAH8ALAAAAAAQABAAAAergH+Cg4SFhCAiIRseFRUX
-Dw6FEkJolZaVQQuEKZctI2dhYVwfhCqXBQRoWllZHKWWYjw7WFVRUR2EK5VgaAcA
-aE5MTBqEJGZlXWAMAl9KR0YWhCVoXFtjCQNXRURDFNJiXlNc2FZBPT4ThCZjWlVY
-2EtANzkRhCdiWVJUCAFJODY0IBDKQGYKFCRPmvyIQQNGA0IKUOioMUPGCxcsXGAw
-UAiRIkaOIBkaaSgQADs=
-}