<> <> <> <> DIRECTORY Atom USING [GetPName, MakeAtom], ChoiceButtons USING [EnumTypeRef, BuildEnumTypeSelection, BuildTextPrompt, GetSelectedButton, UpdateChoiceButtons], Commander USING [CommandProc, Handle, Register], CommandTool USING [NextArgument], Containers USING [ ChildXBound, ChildYBound, Container, Create ], FS USING [ComponentPositions, ExpandName, Position], GList USING [Append], Icons USING [ IconFlavor, NewIconFromFile ], IO USING [atom, STREAM, PutRope, PutFR, RIS, RopeFromROS, rope, ROS], LoganBerryCommands USING [AttributePattern, AttributePatternRec, AttributePatterns, SyntaxError, ReadAttributePatterns, WriteAttributePatterns, PatternsToEntry, FilteredQuery], LoganBerryStub USING [AttributeType, AttributeValue, BuildIndices, Close, CompactLogs, DeleteEntry, Describe, Entry, EntryProc, Error, ErrorCode, Open, OpenDB, SchemaInfo, WriteEntry], Menus USING [AppendMenuEntry, ChangeNumberOfLines, ClickProc, CreateEntry, CreateMenu, GetNumberOfLines, Menu, MenuLine], RefTab USING [Ref, EachPairAction, Fetch, Pairs, Create, Store], Rope USING [Cat, Concat, Equal, ROPE, Substr], Rules USING [ Create, Rule ], TiogaButtons USING [CreateButton, CreateViewer, TiogaButtonProc], TypeScript USING [ Create, ChangeLooks, Reset, PutChar, PutRope ], ViewerBLT USING [ChangeNumberOfLines], ViewerClasses USING [ Viewer, ViewerClassRec, ViewerRec ], ViewerEvents USING [ EventProc, RegisterEventProc ], ViewerOps USING [AddProp, MoveViewer, PaintViewer], ViewerTools USING [GetContents, SetContents] ; LoganBerryBrowserTool: CEDAR PROGRAM IMPORTS Atom, ChoiceButtons, Commander, CommandTool, Containers, FS, GList, Icons, IO, LoganBerryCommands, LoganBerry: LoganBerryStub, Menus, RefTab, Rope, Rules, TiogaButtons, TypeScript, ViewerBLT, ViewerEvents, ViewerOps, ViewerTools = BEGIN <> <<>> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Viewer: TYPE = ViewerClasses.Viewer; BrowserTool: TYPE = REF BrowserToolRec; BrowserToolRec: TYPE = RECORD[ outer: Containers.Container, -- main container menu: Menus.Menu, -- command menu dbFileName: ROPE, -- name of database db: LoganBerry.OpenDB, -- open database handle entryform: RefTab.Ref, -- set of "FormField"s inputArea: Viewer, -- area for type in sortButton: ChoiceButtons.EnumTypeRef, -- order of retrieval details: Containers.Container, -- container for choice buttons historyData: REF ANY, -- log of executed queries history: Viewer, -- viewer for history data inner: Viewer, -- viewer for retrieved database entries stop: BOOLEAN, -- stop database retrievals if TRUE height: CARDINAL _ 0 -- current height of tool (excluding typescript viewer) ]; FormField: TYPE = REF FormFieldRec; FormFieldRec: TYPE = RECORD [ textViewer: Viewer, patternButton: ChoiceButtons.EnumTypeRef ]; AttributePattern: TYPE = LoganBerryCommands.AttributePattern; AttributePatternRec: TYPE = LoganBerryCommands.AttributePatternRec; AttributePatterns: TYPE = LoganBerryCommands.AttributePatterns; HistoryData: TYPE = REF HistoryDataRec; HistoryDataRec: TYPE = RECORD [ tool: BrowserTool, cmd: ROPE, form: AttributePatterns, other: ROPE ]; <<>> <> browserIcon: Icons.IconFlavor _ tool; itemHeight: CARDINAL = 14; interItemHeight: CARDINAL = 5; ruleHeight: CARDINAL = 1; patternButtonWidth: CARDINAL = 100; patternHSpace: CARDINAL = 5; historyHeight: CARDINAL = 100; <> <<>> StopProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; tool.stop _ TRUE; }; BrowseProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; IF mouseButton # blue THEN TypeScript.Reset[tool.inner]; DoOp[$LBQuery, tool]; }; <<>> UpdateProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; DoOp[$LBWrite, tool]; }; DeleteProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; IF mouseButton # blue THEN TypeScript.Reset[tool.inner]; DoOp[$LBDelete, tool]; }; DetailsProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; IF tool.details.wx = 0 THEN HideViewer[tool.details] ELSE UnHideViewer[tool.details]; }; <<>> HistoryProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; IF tool.history.wx = 0 THEN { HideViewer[tool.history]; ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy - historyHeight, w: tool.inner.ww, h: tool.inner.wh]; tool.height _ tool.height - historyHeight; } ELSE { ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy + historyHeight, w: tool.inner.ww, h: tool.inner.wh]; UnHideViewer[tool.history]; tool.height _ tool.height + historyHeight; }; }; AdminOpsProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; newCount: CARDINAL _ IF Menus.GetNumberOfLines[tool.menu] = 1 THEN 2 ELSE 1; Menus.ChangeNumberOfLines[tool.menu, newCount]; ViewerBLT.ChangeNumberOfLines[tool.outer, newCount]; }; <<>> OpenProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> msg: ROPE _ NIL; tool: BrowserTool _ NARROW[clientData]; tool.db _ LoganBerry.Open[dbName: tool.dbFileName ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}]; }; <<>> CloseProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; LoganBerry.Close[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}]; }; <<>> BuildIndicesProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; LoganBerry.BuildIndices[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}]; }; <<>> CompactLogsProc: Menus.ClickProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; LoganBerry.CompactLogs[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}]; }; <<>> DestroyProc: ViewerEvents.EventProc = { <<[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>> <<-- Does nothing at the moment>> <> < {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];>> }; MakeMainMenu: PROC [tool: BrowserTool] RETURNS [] ~ { AppendMenu: PROC[menu: Menus.Menu, name: ROPE, proc: Menus.ClickProc, line: Menus.MenuLine _ 0, guarded: BOOL _ FALSE] = { Menus.AppendMenuEntry[ menu: menu, entry: Menus.CreateEntry[name: name, proc: proc, clientData: tool, guarded: guarded], line: line ]; }; tool.menu _ Menus.CreateMenu[lines: 2]; <> AppendMenu[tool.menu, "STOP!", StopProc]; AppendMenu[tool.menu, "Browse", BrowseProc]; AppendMenu[tool.menu, "Update", UpdateProc]; AppendMenu[tool.menu, "Delete", DeleteProc, 0, TRUE]; AppendMenu[tool.menu, "History", HistoryProc]; AppendMenu[tool.menu, "Details", DetailsProc]; AppendMenu[tool.menu, "AdminOps", AdminOpsProc]; <> AppendMenu[tool.menu, "Open", OpenProc, 1]; AppendMenu[tool.menu, "Close", CloseProc, 1, TRUE]; AppendMenu[tool.menu, "BuildIndices", BuildIndicesProc, 1, TRUE]; AppendMenu[tool.menu, "CompactLogs", CompactLogsProc, 1, TRUE]; }; <<>> <> <<>> MakeEntryForm: PROC [tool: BrowserTool] RETURNS [] ~ { dbSchema: LoganBerry.SchemaInfo _ LoganBerry.Describe[db: tool.db]; tool.entryform _ RefTab.Create[]; FOR k: LIST OF LoganBerry.AttributeType _ dbSchema.keys, k.rest WHILE k # NIL DO field: FormField _ NEW[FormFieldRec]; field.patternButton _ ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, buttonNames: LIST["exact", "prefix", "wildcard", "reg. exp.", "soundex"], default: "prefix", style: flipThru, maxWidth: patternButtonWidth]; field.textViewer _ ChoiceButtons.BuildTextPrompt[viewer: tool.outer, x: field.patternButton.nextx, y: tool.height, title: Rope.Concat[Atom.GetPName[k.first], ":"]].textViewer; tool.height _ tool.height + itemHeight + interItemHeight; [] _ RefTab.Store[tool.entryform, k.first, field]; ENDLOOP; tool.inputArea _ ChoiceButtons.BuildTextPrompt[viewer: tool.outer, x: patternHSpace, y: tool.height, title: "other attributes:"].textViewer; tool.height _ tool.height + itemHeight + interItemHeight; }; MakeSortButton: PROC [tool: BrowserTool] RETURNS [] ~ { AddToSortList: RefTab.EachPairAction = { <<[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]>> choiceList _ CONS[Atom.GetPName[NARROW[key]], choiceList]; RETURN[quit: FALSE]; }; choiceList: LIST OF ROPE _ NIL; [] _ RefTab.Pairs[x: tool.entryform, action: AddToSortList]; tool.height _ tool.height + interItemHeight; tool.sortButton _ ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, title: "Order by:", buttonNames: choiceList, default: NIL, style: menuSelection --vs. flipThru--]; tool.height _ tool.height + itemHeight + interItemHeight; }; ReadEntryForm: PROC [tool: BrowserTool] RETURNS [form: AttributePatterns, other: ROPE] ~ { <> NextField: RefTab.EachPairAction = { <<[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]>> text: ROPE; label: ATOM = NARROW[key]; field: FormField = NARROW[val]; text _ ViewerTools.GetContents[field.textViewer]; IF label # form.first.attr.type AND NOT Rope.Equal[text, ""] THEN { fv: AttributePattern _ NEW[AttributePatternRec]; fv.attr.type _ label; fv.attr.value _ text; fv.ptype _ ChoiceButtons.GetSelectedButton[field.patternButton]; end.rest _ LIST[fv]; end _ end.rest; }; RETURN[quit: FALSE]; }; sort: AttributePattern _ NEW[AttributePatternRec]; end: AttributePatterns; field: FormField; sort.attr.type _ Atom.MakeAtom[ChoiceButtons.GetSelectedButton[tool.sortButton]]; field _ NARROW[RefTab.Fetch[tool.entryform, sort.attr.type].val]; sort.attr.value _ ViewerTools.GetContents[field.textViewer]; sort.ptype _ ChoiceButtons.GetSelectedButton[field.patternButton]; form _ end _ LIST[sort]; [] _ RefTab.Pairs[tool.entryform, NextField]; other _ ViewerTools.GetContents[tool.inputArea]; }; RestoreEntryForm: PROC [tool: BrowserTool, form: AttributePatterns, other: ROPE] RETURNS [] ~ { RestoreField: RefTab.EachPairAction = { <<[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]>> label: ATOM = NARROW[key]; field: FormField = NARROW[val]; f: AttributePatterns; FOR f _ form, f.rest WHILE f # NIL DO IF f.first.attr.type = label THEN EXIT; ENDLOOP; IF f # NIL THEN { ChoiceButtons.UpdateChoiceButtons[tool.details, field.patternButton, f.first.ptype]; ViewerTools.SetContents[field.textViewer, f.first.attr.value, FALSE]; } ELSE { ViewerTools.SetContents[field.textViewer, "", FALSE]; }; RETURN[quit: FALSE]; }; ChoiceButtons.UpdateChoiceButtons[tool.details, tool.sortButton, Atom.GetPName[form.first.attr.type]]; [] _ RefTab.Pairs[tool.entryform, RestoreField]; ViewerTools.SetContents[tool.inputArea, other, FALSE]; ViewerOps.PaintViewer[viewer: tool.outer, hint: all]; }; <<>> <> <<>> <> <> <<>> AddToHistory: PROC [tool: BrowserTool, cmd: ROPE, form: AttributePatterns, other: ROPE] RETURNS [] ~ { data: HistoryData = NEW[HistoryDataRec _ [tool, cmd, form, other]]; line: STREAM _ IO.ROS[]; IO.PutRope[line, cmd]; IO.PutRope[line, " "]; LoganBerryCommands.WriteAttributePatterns[line, form]; IO.PutRope[line, " "]; IO.PutRope[line, other]; [] _ TiogaButtons.CreateButton[viewer: tool.history, rope: IO.RopeFromROS[line], proc: HistoryButtonProc, clientData: data]; }; HistoryButtonProc: TiogaButtons.TiogaButtonProc = { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> < restore the entry form; Middle => restore form and re-execute (not currently implemented).>> data: HistoryData _ NARROW[clientData]; RestoreEntryForm[data.tool, data.form, data.other]; }; <> MakeBrowserTool: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> tool: BrowserTool _ NEW[BrowserToolRec]; shortname: ROPE; cp: FS.ComponentPositions; errormsg: ROPE _ NIL; tool.dbFileName _ CommandTool.NextArgument[cmd]; IF tool.dbFileName = NIL THEN RETURN[msg: "No database name given.\n"]; [tool.dbFileName, cp] _ FS.ExpandName[tool.dbFileName]; <> tool.db _ LoganBerry.Open[dbName: tool.dbFileName ! LoganBerry.Error => {errormsg _ Rope.Cat["Error: ", Atom.GetPName[ec], "  ", explanation]; CONTINUE}]; IF errormsg # NIL THEN RETURN[msg: errormsg]; <> shortname _ Rope.Substr[base: tool.dbFileName, start: cp.base.start, len: cp.base.length]; <> MakeMainMenu[tool]; tool.outer _ Containers.Create[info: [ name: Rope.Concat["LoganBerry Browser: ", tool.dbFileName], icon: browserIcon, label: shortname, iconic: FALSE, column: left, menu: tool.menu, scrollable: FALSE]]; Menus.ChangeNumberOfLines[tool.menu, 1]; ViewerBLT.ChangeNumberOfLines[tool.outer, 1]; ViewerOps.AddProp[viewer: tool.outer, prop: $BrowserTool, val: tool]; [] _ ViewerEvents.RegisterEventProc[proc: DestroyProc, event: destroy, filter: tool.outer]; <> tool.details _ Containers.Create[info: [ parent: tool.outer, ww: 1000, wh: 9999, scrollable: FALSE, border: FALSE]]; <> Containers.ChildYBound[container: tool.outer, child: tool.details]; tool.height _ interItemHeight; MakeEntryForm[tool]; MakeSortButton[tool]; DividingLine[tool]; <> tool.history _ TiogaButtons.CreateViewer[info: [ parent: tool.outer, wy: tool.height, ww: 1000, wh: historyHeight, border: TRUE]]; <> HideViewer[tool.history]; <> tool.inner _ TypeScript.Create[info: [ name: "LoganBerry Browser output", parent: tool.outer, wx: 0, wy: tool.height, ww: 9999, wh: 9999, border: FALSE]]; Containers.ChildXBound[tool.outer, tool.inner]; -- constrain rule to be width of parent Containers.ChildYBound[tool.outer, tool.inner]; -- constrain rule to be height of parent }; <> <<>> DividingLine: PROC [tool: BrowserTool] RETURNS [] ~ { rule: Rules.Rule; rule _ Rules.Create[info: [parent: tool.outer, wx: 0, wy: tool.height, ww: 9999, wh: ruleHeight]]; Containers.ChildXBound[tool.outer, rule]; -- constrain rule to be width of parent tool.height _ tool.height + ruleHeight; }; HideViewer: PROC [v: Viewer] RETURNS [] ~ { ViewerOps.MoveViewer[viewer: v, x: 2000, y: v.wy, w: v.ww, h: v.wh]; }; UnHideViewer: PROC [v: Viewer] RETURNS [] ~ { ViewerOps.MoveViewer[viewer: v, x: 0, y: v.wy, w: v.ww, h: v.wh]; }; <<>> <> DoOp: PROC [cmd: ATOM, tool: BrowserTool] RETURNS [] ~ { ENABLE { LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}; LoganBerryCommands.SyntaxError => {ReportLBError[$MalformedInput, explanation, tool.inner]; CONTINUE} }; PutEntry: LoganBerry.EntryProc = { <<[entry: LoganBerry.Entry] RETURNS [continue: BOOL]>> FOR e: LoganBerry.Entry _ entry, e.rest UNTIL e = NIL DO TypeScript.ChangeLooks[tool.inner, 'b]; -- print atribute type in bold TypeScript.PutRope[tool.inner, Atom.GetPName[e.first.type]]; TypeScript.ChangeLooks[tool.inner, ' ]; -- restore normal looks TypeScript.PutRope[tool.inner, ": "]; TypeScript.PutRope[tool.inner, e.first.value]; TypeScript.PutChar[tool.inner, '\n]; ENDLOOP; TypeScript.PutChar[tool.inner, '\n]; RETURN[NOT tool.stop]; }; DeleteEntry: LoganBerry.EntryProc = { <<[entry: LoganBerry.Entry] RETURNS [continue: BOOL]>> value: LoganBerry.AttributeValue _ GetAttributeValue[entry, primaryKey]; LoganBerry.DeleteEntry[db: tool.db, key: primaryKey, value: value]; TypeScript.PutRope[tool.inner, IO.PutFR["Deleted %g: %g\n", IO.atom[primaryKey], IO.rope[value]]]; RETURN[NOT tool.stop]; }; other: ROPE; all, form, otherPatterns: AttributePatterns; primaryKey: LoganBerry.AttributeType; entry: LoganBerry.Entry; tool.stop _ FALSE; [form, other] _ ReadEntryForm[tool]; otherPatterns _ LoganBerryCommands.ReadAttributePatterns[IO.RIS[other]]; all _ NARROW[GList.Append[form, otherPatterns]]; AddToHistory[tool, Atom.GetPName[cmd], form, other]; SELECT cmd FROM $LBQuery => { LoganBerryCommands.FilteredQuery[db: tool.db, patterns: all, proc: PutEntry]; }; $LBWrite => { entry _ LoganBerryCommands.PatternsToEntry[all]; LoganBerry.WriteEntry[db: tool.db, entry: entry]; }; $LBDelete => { primaryKey _ LoganBerry.Describe[db: tool.db].info.keys.first; LoganBerryCommands.FilteredQuery[db: tool.db, patterns: all, proc: DeleteEntry]; }; ENDCASE => NULL; }; GetAttributeValue: PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] ~ { FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO IF e.first.type = type THEN RETURN[e.first.value]; ENDLOOP; RETURN[NIL]; }; ReportLBError: PROC [ec: LoganBerry.ErrorCode, explanation: ROPE, v: Viewer] RETURNS [] ~ { TypeScript.Reset[v]; TypeScript.PutRope[v, Rope.Cat["Error: ", Atom.GetPName[ec], "  ", explanation]]; }; <> browserIcon _ Icons.NewIconFromFile[file: "LoganBerry.icons", n: 0 ! ANY => CONTINUE]; Commander.Register[key: "LoganBerryBrowser", proc: MakeBrowserTool, doc: "Create a LoganBerry browser." ]; Commander.Register[key: "LBBrowser", proc: MakeBrowserTool, doc: "Create a LoganBerry browser." ]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>> <<>> <<>> <<>> << >> <> <> <<>>