diff options
author | Hans-Christoph Steiner <eighthave@users.sourceforge.net> | 2011-01-17 21:05:23 +0000 |
---|---|---|
committer | Hans-Christoph Steiner <eighthave@users.sourceforge.net> | 2011-01-17 21:05:23 +0000 |
commit | ab44363d3120d6f8bfe7c7266d88b0b9aa42282c (patch) | |
tree | 38f453647ac037db71ae8e2e7fab64f2f642d4ee /category_menu-plugin.tcl |
first stab at a simple plugin for creating a object-by-category menu by a simple text filesvn2git-root
svn path=/trunk/scripts/guiplugins/category_menu-plugin/; revision=14749
Diffstat (limited to 'category_menu-plugin.tcl')
-rw-r--r-- | category_menu-plugin.tcl | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/category_menu-plugin.tcl b/category_menu-plugin.tcl new file mode 100644 index 0000000..a5821e1 --- /dev/null +++ b/category_menu-plugin.tcl @@ -0,0 +1,40 @@ + +package require pd_menus + +namespace eval category_menu { +} + +proc category_menu::load_menutree {} { + # load object -> tags mapping from file in Pd's path + set testfile [file join $::current_plugin_loadpath menutree.tcl] + set f [open $testfile] + set menutree [read $f] + close $f + unset f + return $menutree +} + +proc category_menu::create {mymenu} { + pdtk_post "category menu plugin\n" + set menutree [load_menutree] + + $mymenu add separator + foreach categorylist $menutree { + set category [lindex $categorylist 0] + menu $mymenu.$category + $mymenu add cascade -label $category -menu $mymenu.$category + foreach subcategorylist [lrange $categorylist 1 end] { + set subcategory [lindex $subcategorylist 0] + menu $mymenu.$category.$subcategory + $mymenu.$category add cascade -label $subcategory -menu $mymenu.$category.$subcategory + pdtk_post "subcategorylist: $subcategorylist\n" + foreach item [lindex $subcategorylist 1] { + pdtk_post "item: $item\n" + $mymenu.$category.$subcategory add command -label $item \ + -command "pdsend \"\$::focused_window obj \$::popup_xcanvas \$::popup_ycanvas $item\"" + } + } + } +} + +category_menu::create .popup |