MODULE TestMenu; (** AUTHOR "TF/staubesv" PURPOSE "Testbed for WMMenus.Mod" *) IMPORT KernelLog, Modules, Commands,Strings, Files, XML, XMLObjects, XMLScanner, XMLParser, WMGraphics, WMMessages, WM := WMWindowManager, WMComponents, WMStandardComponents, WMTrees, WMMenus; TYPE KillerMsg = OBJECT END KillerMsg; Window* = OBJECT (WMComponents.FormWindow) VAR menu : WMTrees.Tree; menuPanel : WMMenus.MenuPanel; hasErrors : BOOLEAN; PROCEDURE CreateForm() : WMComponents.VisualComponent; VAR panel : WMStandardComponents.Panel; root : WMTrees.TreeNode; BEGIN NEW(panel); panel.bounds.SetExtents(800, 700); panel.fillColor.Set(LONGINT(0FFFFFFFFH)); panel.takesFocus.Set(TRUE); NEW(menu); NEW(root); NEW(menuPanel); menuPanel.fillColor.Set(LONGINT(WMGraphics.White)); menuPanel.bounds.SetHeight(20); menuPanel.alignment.Set(WMComponents.AlignTop); menuPanel.horizontal.Set(TRUE); menuPanel.openDirection.Set(WMMenus.OpenDownRight); menuPanel.SetMenu(menu, root); menuPanel.onSelect.Add(Selected); panel.AddContent(menuPanel); RETURN panel END CreateForm; PROCEDURE &New*; VAR vc : WMComponents.VisualComponent; BEGIN IncCount; (* To create a multi language app, try loading the respective XML instead of CreateForm() if the XML was not found or does not contain all needed elements, use CreateForm as fallback *) vc := CreateForm(); Init(vc.bounds.GetWidth(), vc.bounds.GetHeight(), FALSE); SetContent(vc); WM.DefaultAddWindow(SELF); SetTitle(Strings.NewString("Test Window")); END New; PROCEDURE AddMenuItem(node : WMTrees.TreeNode; xml : XML.Element); VAR newNode : WMTrees.TreeNode; BEGIN NEW(newNode); menu.AddChildNode(node, newNode); menu.SetNodeData(newNode, xml); menu.SetNodeCaption(newNode, xml.GetAttributeValue("caption")); END AddMenuItem; PROCEDURE Selected(sender, data : ANY); VAR s : Strings.String; BEGIN IF ~sequencer.IsCallFromSequencer() THEN sequencer.ScheduleEvent(SELF.Selected, sender, data) ELSE IF (data # NIL) & (data IS WMTrees.TreeNode) THEN menu.Acquire; s := menu.GetNodeCaption(data(WMTrees.TreeNode)); IF s # NIL THEN KernelLog.String(s^); KernelLog.Ln; END; menu.Release; END END END Selected; PROCEDURE AddSubMenu(node : WMTrees.TreeNode; xml : XML.Element ); VAR en : XMLObjects.Enumerator; p : ANY; s : Strings.String; newNode : WMTrees.TreeNode; BEGIN NEW(newNode); menu.AddChildNode(node, newNode); menu.SetNodeData(newNode, xml); menu.SetNodeCaption(newNode, xml.GetAttributeValue("caption")); en := xml.GetContents(); WHILE en.HasMoreElements() DO p := en.GetNext(); IF p IS XML.Element THEN s := p(XML.Element).GetName(); IF s # NIL THEN IF s^ = "MenuItem" THEN AddMenuItem(newNode, p(XML.Element)) ELSIF s^ = "SubMenu" THEN AddSubMenu(newNode, p(XML.Element)) END END END END; END AddSubMenu; PROCEDURE SetDocument(xml : XML.Element); VAR en : XMLObjects.Enumerator; p : ANY; s : Strings.String; node : WMTrees.TreeNode; BEGIN NEW(node); menu.Acquire; menu.SetRoot(node); menu.SetNodeState(node, {WMTrees.NodeAlwaysExpanded}); menu.SetNodeData(node, xml); en := xml.GetContents(); WHILE en.HasMoreElements() DO p := en.GetNext(); IF p IS XML.Element THEN s := p(XML.Element).GetName(); IF s # NIL THEN IF s^ = "SubMenu" THEN AddSubMenu(node, p(XML.Element)) ELSIF s^ = "MenuItem" THEN AddMenuItem(node, p(XML.Element)) END END END END; menu.Release; menuPanel.SetMenu(menu, node) END SetDocument; PROCEDURE Error(pos, line, row : LONGINT; CONST msg : ARRAY OF CHAR); BEGIN KernelLog.String("Parse error at pos "); KernelLog.Int(pos, 5); KernelLog.String(" in line "); KernelLog.Int(line, 5); KernelLog.String(" row "); KernelLog.Int(row, 5); KernelLog.String(" - "); KernelLog.String(msg); KernelLog.Ln; hasErrors := TRUE END Error; PROCEDURE Read(CONST name : ARRAY OF CHAR); VAR f : Files.File; r : Files.Reader; scanner : XMLScanner.Scanner; parser : XMLParser.Parser; doc : XML.Document; BEGIN hasErrors := FALSE; f := Files.Old(name); IF f # NIL THEN Files.OpenReader(r, f, 0); NEW(scanner, r); scanner.reportError := Error; NEW(parser, scanner); parser.reportError := Error; doc := parser.Parse(); IF hasErrors THEN KernelLog.String("menu not loaded"); KernelLog.Ln ELSE SetDocument(doc.GetRoot()); END ELSE KernelLog.String("name = "); KernelLog.String(name); KernelLog.String(" not found"); KernelLog.Ln END END Read; PROCEDURE Close*; BEGIN Close^; DecCount END Close; PROCEDURE Handle*(VAR x : WMMessages.Message); BEGIN IF (x.msgType = WMMessages.MsgExt) & (x.ext # NIL) & (x.ext IS KillerMsg) THEN Close ELSE Handle^(x) END END Handle; END Window; TYPE Command = OBJECT VAR commandString : ARRAY 256 OF CHAR; PROCEDURE &Init(CONST commandString : ARRAY OF CHAR); BEGIN COPY(commandString, SELF.commandString); END Init; PROCEDURE Execute; VAR ignoreRes : WORD; ignoreMsg : ARRAY 1 OF CHAR; BEGIN Commands.Call(commandString, {}, ignoreRes, ignoreMsg); END Execute; END Command; VAR nofWindows : LONGINT; lastMenu : WMTrees.Tree; (* not thread-safe *) PROCEDURE Open*; VAR winstance : Window; BEGIN NEW(winstance); winstance.Read("Menu.XML"); END Open; PROCEDURE HandleItemSelected(sender, data : ANY); VAR caption : Strings.String; menu : WMTrees.Tree; BEGIN IF (data # NIL) THEN IF (data IS Command) THEN data(Command).Execute; ELSE menu := lastMenu; IF (menu # NIL) THEN caption := WMMenus.GetCaption(data, menu); KernelLog.String("Selected node: "); IF (caption # NIL) THEN KernelLog.String(caption^); ELSE KernelLog.String("NIL"); END; KernelLog.Ln; ELSE KernelLog.String("Test error: Menu not available"); KernelLog.Ln; END; END; END; END HandleItemSelected; PROCEDURE OpenPopup*(context : Commands.Context); VAR path, commandString : ARRAY 256 OF CHAR; menu : WMTrees.Tree; node : WMTrees.TreeNode; command : Command; BEGIN NEW(menu); lastMenu := menu; WHILE context.arg.GetString(path) DO IF context.arg.GetString(commandString) THEN NEW(command, commandString); node := WMMenus.AddItemNode(path, menu); menu.Acquire; menu.SetNodeData(node, command); menu.Release; END; END; WMMenus.Show(menu, 100, 100, HandleItemSelected); END OpenPopup; PROCEDURE IncCount; BEGIN {EXCLUSIVE} INC(nofWindows) END IncCount; PROCEDURE DecCount; BEGIN {EXCLUSIVE} DEC(nofWindows) END DecCount; PROCEDURE Cleanup; VAR die : KillerMsg; msg : WMMessages.Message; m : WM.WindowManager; BEGIN {EXCLUSIVE} NEW(die); msg.ext := die; msg.msgType := WMMessages.MsgExt; m := WM.GetDefaultManager(); m.Broadcast(msg); AWAIT(nofWindows = 0) END Cleanup; BEGIN Modules.InstallTermHandler(Cleanup) END TestMenu. System.Free TestMenu WMMenus ~ TestMenu.Open ~ TestMenu.OpenPopup Inspect.Performance WMPerfMon.Open Inspect.Profiler WMProfiler.Open Inspect.Events WMEvents.Open Inspect.Components WMInspector.Open --- NoCommand Tools.Search WMSearchTool.Open Tools.Archiver WMArchives.Open Tools.Console WMShell.Open "Tools.Partition Manager" WMPartitions.Open "Tools.Partition Editor" WMPartitionEditor.Open --- NoCommand Commands.Files.ShowFS FSTools.Watch Commands.Files.Directory "FSTools.Directory *" Commands.Partitions.Show Partitions.Show ~~