Generic nested menus implementation
Leonid Shifrin
since already two people asked for this feature, and I got interested
myself, I assume that this topic may be of general interest, and this is my
reason to start a separate thread. Here I present my first attempt at
generic multilevel menu implementation. The code is probably full of bugs,
and also perhaps many parts could be done easier but I just did not figure
it out, so I will appreciate any feedback. The examples of use follow.
THE CODE
-----------------------------------------------------------------------------------------------------------------------
(* checking recursive pattern *)
Clear[menuTreeValidQ];
menuTreeValidQ[{_String, {___String}}] := True;
menuTreeValidQ[item_] := MatchQ[item, {_String, {___?menuTreeValidQ} ..}];
(* This can probably be done much better *)
Clear[localMaxPositions];
localMaxPositions[ls_List] :=
Module[{n = 0, pos, part},
pos = Position[part = Split[Partition[ls, 3, 1], Last[#1] == First[#2]
&],
x_ /; MatchQ[x, {{s_, t_, u_}} /; s <= t && u <= t] ||
MatchQ[x, {{s_, t_, _}, ___, {_, u_, p_}} /; s <= t && u >= p]];
List /@ Flatten[Fold[
Function[{plist, num}, n++;
Join[plist[[1 ;; n - 1]], Range[plist[[n]], plist[[n]] + num - 1],
plist[[n + 1 ;;]] + num - 1]], pos, Length /@ Extract[part, pos]] +
1]];
(* By leaves I here mean, for every branch, those with locally
largest distance from the stem. Level would not do *)
Clear[leafPositions];
leafPositions[tree_] :=
Extract[#, localMaxPositions[Length /@ #]] &@
Reap[MapIndexed[Sow[#2] &, tree , Infinity]][[2, 1]];
Clear[mapOnLeaves];
mapOnLeaves[f_, tree_] := MapAt[f, tree, leafPositions[tree]];
Clear[replaceByEvaluated];
replaceByEvaluated[expr_, patt_] :=
With[{pos = Position[expr, patt]},
With[{newpos =
Split[Sort[pos, Length[#1] > Length[#2] &],
Length[#1] == Length[#2] &]},
Fold[ReplacePart[#1, Extract[#1, #2], #2, List /@ Range[Length[#2]]] &,
expr, newpos]]];
(* converts initial string-based menu tree into more complex expression
suitable for menu construction *)
Clear[menuItemsConvertAlt];
menuItemsConvertAlt[menuitemTree_, menuMakers : {(_Symbol | _Function) ..},
actionF_, representF_: (# &), representLeavesF_: (# &)] :=
Module[{g, actionAdded, interm, maxdepth, actF},
actionAdded =
mapOnLeaves[If[# === {}, Sequence @@ #, representLeavesF[#] :> actF[#]]
&,
menuitemTree];
interm =
MapIndexed[
Replace[#, {x_String, y : ({({_RuleDelayed} | _RuleDelayed) ..})} :>
representF[x, {Length[#2]/2}] :> g[Length[#2]/2][x, Flatten@y],
1] &, {actionAdded}, Infinity];
interm =
Fold[replaceByEvaluated,
interm, {_Replace, HoldPattern[# &[__]], HoldPattern[Length[{___}]],
HoldPattern[Times[_Integer, Power[_Integer, -1]]], _Flatten}][[1, 2]];
maxdepth = Max[Cases[interm, g[x_] :> x, Infinity, Heads -> True]];
With[{fns = menuMakers},
replaceByEvaluated[interm /. g[n_Integer] :> menuMakers[[n]],
HoldPattern[fns[[_Integer]]]] /. actF :> actionF
] /; maxdepth <= Length[menuMakers]]
(* main menu-building function *)
Clear[createNestedMenu];
createNestedMenu::invld = "The supplied menu tree structure is not valid";
createNestedMenu[menuItemTree_, ___] /; Not[menuTreeValidQ[menuItemTree]] :=
"never happens" /; Message[createNestedMenu::invld];
createNestedMenu[menuItemTree_?menuTreeValidQ, menuCategories_, actionF_,
representF_: (# &), representLeavesF_: (# &)] :=
Module[
{menuVars, menuNames, menuDepth = Depth[Last@menuItemTree]/2,
setHeld, setDelayedHeld, heldPart, subBack, subBackAll, makeSubmenu,
addSpaces, menuCategs = menuCategories, standardCategory = " Choose
"},
Options[makeSubmenu] = {Appearance -> "Button",
FieldSize -> {{1, 8}, {1, 4}}, Background -> Lighter[Yellow, 0.8],
BaseStyle -> {FontFamily -> "Helvetica", FontColor -> Brown,
FontWeight -> Plain}};
menuCategs = PadRight[menuCategs, menuDepth + 1, standardCategory];
(* Make variables to store menu names and values *)
Block[{var, name}, {menuVars, menuNames} =
Apply[ Hold, Evaluate[Table[Unique[#], {menuDepth}]]] & /@ {var,
name}];
(* Functions to set/extract held variables *)
setHeld[Hold[var_], rhs_] := var = rhs;
setDelayedHeld[Hold[var_], rhs_] := var := rhs;
heldPart[seq_Hold, n_] := First[Extract[seq, {{n}}, Hold]];
(* Functions to close the given menu/submenus*)
subBack[depth_Integer] :=
(If[depth =!= menuDepth + 1, setHeld[heldPart[menuVars, depth], ""]];
setHeld[heldPart[menuNames, depth - 1], menuCategs[[depth - 1]]]);
subBackAll[depth_Integer] := subBack /@ Range[menuDepth + 1, depth, -1];
(* Function to create a (sub)menu at a given level *)
makeSubmenu[depth_] :=
Function[{nm, actions},
subBackAll[depth + 1];(* remove lower menus if they are open *)
If[depth =!= 1, setHeld[heldPart[menuNames, depth - 1], nm]];
setDelayedHeld[heldPart[menuVars, depth],
Dynamic@
ActionMenu[menuNames[[depth]],
If[depth === 1, actions,
Prepend[actions, "Back" :> subBackAll[depth]]], AutoAction -> True,
Sequence @@ Options[makeSubmenu]]]];
(* Function to help with a layout *)
addSpaces[x_List, spaceLength : (_Integer?Positive) : 10] :=
With[{space = StringJoin @@ Table[" ", {spaceLength}]},
MapIndexed[ReplacePart[Table[space, {Length[x]}], ##] &, x]];
(* Initialization code *)
subBackAll[2];
menuItemsConvertAlt[
{menuNames[[1]], {menuItemTree}}, makeSubmenu /@ Range[menuDepth],
actionF, representF, representLeavesF][[1, 2]];
(* Display the menus *)
Dynamic[
Function[Null,
Grid[addSpaces[{##}, 5], Frame -> True, FrameStyle -> Thick,
Background -> Lighter[Pink, 0.8]], HoldAll] @@ menuVars]
]; (* End Module *)
-----------------------------------------------------------------------------------------------------------
EXAMPLES and explanation
So, the input for a menu should be a tree structure like this:
In[1] = menuItems =
{"Continents", {{"Africa", {{"Algeria", {"Algiers",
"Oran"}}, {"Angola", {"Luanda",
"Huambo"}}}}, {"North America", {{"United States", {"New \
York", "Washington"}}, {"Canada", {"Toronto", "Montreal"}}}}}};
The root of the tree ("Continents" in this case) is not used later (but
needed for consistency), so can be any string.
The second necessary ingredient is a list of categories (strings) of the
length equal to the depth of the menu to be constructed, or less (in which
case some subcategories will be shown with a standard header "Choose"). The
last mandatory ingredient is a function representing the action to be taken
upon clicking on the lowest-level menu item (leaf).
This is how we create the menu:
In[1] = createNestedMenu[menuItems, {"Continent", " Country ", " City
"}, Print]
In this case, all categories are given explicilty, and when we click on an
"atomic" menu element (not representing further menu sub-levels), it is
printed. You can also omit some sub-categories, they will be substituted by
"Choose"
In[2] = createNestedMenu[menuItems, {"Continent"}, Print]
There are additional optional parameters, which allow us to represent
different submenu items in different way - functions
representF and representLeavesF. The first one governs the appearance of
the non-atomic submenu elements and takes the level of a submenu as a second
argument. The second governs the appearance of atomic menu elements
(leaves). For example:
In[3] =
createNestedMenu[menuItems, {"Continent", " Country ",
" City "}, Print, (Style[#, FontColor ->
Switch[#2, {1}, Brown, {2}, Blue, {3}, Green, _True,
Orange], #]) &, Style[#, Red] &]
I went through some pains to ensure that the menu will work also on less
regular menu trees, where leaves may have different distance from the stem,
like here:
In[4] =
menuTreeValidQ@
(compMenuItems = {"Company",
{{"Services",
{"Training", "Development"}},
{"Products",
{{"OS tools", {}},
{"Application software", {}}
}},
{"News",
{{"Press releases", {}},
{"Media coverage", {}}
}},
{"Company",
{{"Vacancies", {{"Developer", {"Requirements"}}, {"Tester",
{}}}},
{"Structure", {}}}
}
}})
Out[4] = True
We create the menu as before:
In[5] = createNestedMenu[compMenuItems, {"Main"}, Print]
where I omitted sub-categories.
Notice that the syntax I chose is such that, whenever the submenu contains
only atomic elements, they can either all be represented by just strings, or
wrapped in lists as {element,{}}, but not mixed. But if menu contains a mix
of atomic and non-atomic elements, atomic elements must be wrapped in lists
as above. For example, the more "politically correct"
way to represent the first example structrure is this:
{"Continents", {{"Africa", {{"Algeria", {{"Algiers", {}}, {"Oran", \
{}}}}, {"Angola", {{"Luanda", {}}, {"Huambo", {}}}}}}, {"North \
America", {{"United States", {{"New York", {}}, {"Washington", {}}}}, \
{"Canada", {{"Toronto", {}}, {"Montreal", {}}}}}}}}
The menuTreeValidQ predicate can be used to test if the structure is valid
or not.
Hope that I don't waste everyone's time and bandwidth.
All feedback is greatly appreciated.
Regards,
Leonid
Leonid Shifrin
a quick follow - up:
There is a bug in the function <localMaxPositions> that returns the
positions of the locally maximal numbers in a list. Here is a better (and
hopefully correct) version:
Clear[localMaxPositions];
localMaxPositions[lst_List] :=
Part[#, All, 2] &@
ReplaceList[
MapIndexed[List,
lst], {___, {x_, _}, y : {t_, _} .., {z_, _}, ___} /;
x < t && z < t :> y];
Sorry for this.
Regards,
Leonid
Albert Retey
I have played around with your initial idea also, and appended is what I
came up with...
hth,
albert
(* START OF CODE *)
(* just a little helper *)
ClearAll@toLabel;
toLabel[s_String] := s;
toLabel[s_String -> l_List] := s;
toLabel[s_String :> _] := s;
(* the heart of the code: recursive definition of the action menues *)
ClearAll@createNextLevel;
SetAttributes[createNextLevel, HoldFirst];
Options[createNextLevel] = Flatten[{
Options[ActionMenu], "AppearanceWrapper" -> Row,
"DefaultLabels" -> {}
}];
createNextLevel[{levels_, stack_}, label_String, action_,
opts : OptionsPattern[]] := (
Do[levels[i] =., {i, Length[stack] + 1,
Max[DownValues[levels][[All, 1, 1, 1]]]}];
action[stack]
);
createNextLevel[{levels_, stack_}, label_String :> myaction_, action_,
opts : OptionsPattern[]] := (
Do[levels[i] =., {i, Length[stack] + 1,
Max[DownValues[levels][[All, 1, 1, 1]]]}];
myaction
);
createNextLevel[{levels_, stack_}, label_String -> items_List,
action_, opts : OptionsPattern[]] := With[{
defaultlabel = Function[
Which[
Length[#] >= Length[stack] + 1, #[[Length[stack] + 1]],
Length[#] > 0, Last[#],
True, "Choose"
]
][OptionValue["DefaultLabels"]]
},
Do[levels[i] =., {i, Length[stack] + 1,
Max[DownValues[levels][[All, 1, 1, 1]]]}];
levels[Length[stack]] = With[{i = Length[stack] + 1},
ActionMenu[
Dynamic[
If[Length[stack] >= i, stack[[i]], defaultlabel]
],
Map[
toLabel[#] :> (
stack = Append[Take[stack, i - 1], toLabel[#]];
createNextLevel[{levels, stack}, #, action, opts];
) &,
items
],
FilterRules[Flatten@{opts}, Options[ActionMenu]]
]
]
];
(* main function to call *)
ClearAll@nestedActionMenu
Options[nestedActionMenu] = Flatten[{
"AppearanceWrapper" -> Row, "DefaultLabels" -> {},
Options[ActionMenu]
}];
nestedActionMenu[items_List, action_: None, opts : OptionsPattern[]] :=
With[{
defaultlabel =
Function[If[Length[#] > 0, #[[1]], "Choose"]][
OptionValue["DefaultLabels"]]
},
DynamicModule[{
levels, stack = {}
},
levels[0] = ActionMenu[
Dynamic[If[Length[stack] > 0, stack[[1]], defaultlabel]],
Map[
toLabel[#] :> (
stack = {toLabel[#]};
createNextLevel[{levels, stack}, #, action, opts]) &,
items
],
FilterRules[Flatten@{opts}, Options[ActionMenu]]
];
Column[{
Dynamic[OptionValue["AppearanceWrapper"][
Table[
levels[i], {i, 0, Max[DownValues[levels][[All, 1, 1, 1]]]}]
]]
}]
]
];
(* END OF CODE *)
(* simple example usage, with the default there are no actions! *)
nestedActionMenu[{
"Africa" -> {
"Algeria" -> {"Algiers", "Oran"},
"Angola" -> {"Luanda", "Huambo"}
},
"North America" -> {
"United States" -> {"New York", "Washington"},
"Canada" -> {"Toronto", "Montreal"}
}
}
]
(* example with actions, they can be given globaly or locally for \
each entry *)
Deploy@nestedActionMenu[{
"Africa" -> {
"Algeria" -> {"Algiers", "Oran"},
"Angola" -> {"Luanda", "Huambo"}
},
"North America" -> {
"United States" -> {"New York", "Washington"},
"Canada" -> {"Toronto",
"Montreal" :> Print["Monteral is special!"]}
}
},
Print,
"DefaultLabels" -> {"Continent", "Country", "City"}
]
(*
somewhat more involved example,menu definition is created \
programmatically from CountryData and CityData, watch out,this will \
not work well when ContryData and CityData are not yet initialized \
and will take a while to finish
*)
menuDefinition = Map[
Function[cont, cont -> Map[
# -> CountryData[#, "LargestCities"][[All, 1]] &,
CountryData[cont]
]
],
DeleteCases[CountryData["Continents"], "Antarctica"]
];
(* example for a more interesting global action *)
cityinfo[{continent___, country_, city_}] := CreateDialog[{
Grid[{
{Style[city, "Section"],
Show[CountryData[country, "Flag"], ImageSize -> 50]},
{continent, country},
{"Population", CityData[city, "Population"]},
{"Elevation", CityData[city, "Elevation"]}
}, Alignment -> {{Left, Right}, Automatic}], DefaultButton[]
}]
(* check that the global action works: *)
cityinfo[{"Europe", "Switzerland", "Zurich"}]
(*
now we are ready to install the nested action menu in a "menu bar", \
we use the option "AppearanceWrapper" for further formatting...
*)
SetOptions[EvaluationNotebook[],
DockedCells -> {
Cell[BoxData[ToBoxes[Button["City Information",
CreateDialog[{ExpressionCell[Panel[
nestedActionMenu[
menuDefinition, (DialogReturn[]; cityinfo[#]) &,
Appearance -> None,
"AppearanceWrapper" ->
Function[
Grid[{#}, Alignment -> Left, Dividers -> All,
FrameStyle -> LightGray, ItemSize -> {10, 1}]],
"DefaultLabels" -> {"Continent", "Country", "City"}
],
ImageMargins -> 0, FrameMargins -> 0
],
CellMargins -> {{0, 0}, {0, 0}}
]},
WindowMargins -> {
{MousePosition["ScreenAbsolute"][[1]],
Automatic}, {Automatic,
MousePosition["ScreenAbsolute"][[2]] - 40}},
WindowFrame -> "Frameless",
CellMargins -> 0,
CellFrameMargins -> 0,
WindowSize -> FitAll
],
Appearance -> None
]
]],
"DockedCell"
]
}
]
meitnik
Oh yes!, this is what I needed 3 months ago. Some tweaks requested/
questions:
1. how do I set options for the visual aspects (ie, imagesize, color,
fontsize etc.) of the ActionMenu in the code. Its hard to figure that
out somewhat. Or, did you take over any ability to set those options.
2. I would like to set visual options per level (ie, Level1->Blue,
Level2->Red, etc.) like this (similer to how grid works): {1->Blue,2-
>Red}, or via name of each level. Or, allow use of BaseStyle for whole
shabang.
3. The "choose' part be given options of color, fontsize etc. or even
another word, "Pick", even a symbol character.
4. Set up the code so it can live/work after the kernel is off. See J.
Fultz's really cool and informative notebooks on dynamic stuff.
And finally, Thank you for sharing the code. Very helpful to solve a
number of Gui problems for me. :-)
andrew
meitnik
1. I would like instead of choose, a forward menuitem at top of menu
and a back menuitem at bottom of actionmenu so I can collapse back to
the root menu. Ideally, I would put arrow chars for each for visual
polish.
2. When I do a FullDefinition on the main function call, I get some
errors.
Again, am learning stuff. ;-)
andrew