<> <> <> <> DIRECTORY Atom USING [GetPName, MakeAtom], ChoiceButtons USING [EnumTypeRef, BuildEnumTypeSelection, BuildTextPrompt, GetSelectedButton], Commander USING [CommandProc, Handle, Register], CommandTool USING [NextArgument], Containers USING [ ChildXBound, ChildYBound, Container, Create ], FS USING [ComponentPositions, ExpandName, Position], Icons USING [ IconFlavor, NewIconFromFile ], LoganBerry USING [AttributeType, AttributeValue, BuildIndices, Close, CompactLogs, Describe, Entry, EntryProc, Error, ErrorCode, Open, OpenDB, SchemaInfo], LoganBerryRpcControl USING [ImportInterface, UnimportInterface], LoganQuery USING [ComplexCursor, EndGenerate, FilterEntries, FilterProc, GenerateEntries, MergeEntries, NextEntry, Equal, Prefix, Wildcard, RE, Soundex], LupineRuntime USING [BindingError], Menus USING [AppendMenuEntry, ChangeNumberOfLines, ClickProc, CreateEntry, CreateMenu, GetNumberOfLines, Menu, MenuLine], MessageWindow USING [Append, Blink], RefTab USING [Ref, EachPairAction, Fetch, Pairs, Create, Store], Rope USING [Cat, Concat, Equal, Fetch, FromChar, Index, Length, ROPE, SkipTo, Substr], RPC USING [CallFailed, CallFailure, ImportFailed], Rules USING [ Create, Rule ], TiogaButtons USING [ CreateButton, CreateButtonFromNode, CreateViewer, FindTiogaButton, GetRope, LoadViewer, TextNodeRef, TiogaButton, TiogaButtonProc, TiogaOpsRef ], <> TypeScript USING [ Create, ChangeLooks, Reset, PutChar, PutRope ], ViewerBLT USING [ChangeNumberOfLines], ViewerClasses USING [ Viewer, ViewerClassRec, ViewerRec ], ViewerEvents USING [ EventProc, RegisterEventProc ], ViewerOps USING [AddProp, FetchProp, MoveViewer, PaintViewer], ViewerTools USING [GetContents] ; LoganBerryBrowserTool: CEDAR PROGRAM IMPORTS Atom, ChoiceButtons, Commander, CommandTool, Containers, FS, Icons, LoganBerry, LoganBerryRpcControl, LoganQuery, LupineRuntime, Menus, MessageWindow, RefTab, Rope, RPC, Rules, TiogaButtons, --TiogaButtonsExtra,-- TypeScript, ViewerBLT, ViewerEvents, ViewerOps, ViewerTools = BEGIN <> <<>> ROPE: TYPE = Rope.ROPE; 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 instance: ROPE, -- RPC interface instance imported: BOOL_FALSE, -- is interface imported? db: LoganBerry.OpenDB, -- open database handle entryform: RefTab.Ref, -- set of "FormField"s 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 ]; <<>> <> 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]; DoQuery[tool.db, tool.entryform, Atom.MakeAtom[ChoiceButtons.GetSelectedButton[tool.sortButton]], tool.inner, tool]; ViewerOps.PaintViewer[viewer: tool.inner, hint: all]; }; <<>> 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; }; MessageWindow.Append["Not fully implemented.", TRUE]; MessageWindow.Blink[]; }; 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}]; }; <<>> BuildIndiciesProc: 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, "Details", DetailsProc]; AppendMenu[tool.menu, "History", HistoryProc]; AppendMenu[tool.menu, "AdminOps", AdminOpsProc]; <> AppendMenu[tool.menu, "Open", OpenProc, 1]; AppendMenu[tool.menu, "Close", CloseProc, 1, TRUE]; AppendMenu[tool.menu, "BuildIndicies", BuildIndiciesProc, 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; }; 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; }; <<>> <> MakeBrowserTool: Commander.CommandProc = { <<[cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL]>> tool: BrowserTool _ NEW[BrowserToolRec]; position: FS.Position; 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.instance _ Rope.Substr[tool.dbFileName, cp.server.start, cp.server.length]; tool.dbFileName _ Rope.Concat["[]", Rope.Substr[tool.dbFileName, cp.dir.start-1]]; <> <> <> tool.imported _ TRUE; <> tool.db _ LoganBerry.Open[dbName: tool.dbFileName ! LoganBerry.Error => errormsg _ Rope.Cat["Error: ", Atom.GetPName[ec], "  ", explanation]]; IF errormsg # NIL THEN RETURN[msg: errormsg]; <> position _ FS.ExpandName[tool.dbFileName].cp.base; shortname _ Rope.Substr[base: tool.dbFileName, start: position.start, len: position.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: 9999, wh: 9999, scrollable: FALSE, border: FALSE]]; Containers.ChildXBound[container: tool.outer, child: tool.details]; 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: 9999, wh: historyHeight, border: TRUE]]; Containers.ChildXBound[tool.outer, tool.history]; -- constrain rule to be width of parent 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]; }; <<>> <> DoQuery: PROC [db: LoganBerry.OpenDB, form: RefTab.Ref, sortby: LoganBerry.AttributeType, v: Viewer, tool: BrowserTool] RETURNS [] ~ { ENABLE { LoganBerry.Error => {ReportLBError[ec, explanation, v]; CONTINUE}; RPC.CallFailed => {PostRPCError[why, v]; CONTINUE}; }; PutEntry: LoganBerry.EntryProc ~ { <> FOR e: LoganBerry.Entry _ entry, e.rest UNTIL e = NIL DO TypeScript.ChangeLooks[v, 'b]; -- print atribute type in bold TypeScript.PutRope[v, Atom.GetPName[e.first.type]]; TypeScript.ChangeLooks[v, ' ]; -- restore normal looks TypeScript.PutRope[v, ": "]; TypeScript.PutRope[v, e.first.value]; TypeScript.PutChar[v, '\n]; ENDLOOP; TypeScript.PutChar[v, '\n]; RETURN[TRUE]; }; NewFilter: RefTab.EachPairAction = { <<[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]>> field: FormField = NARROW[val]; contents: ROPE _ ViewerTools.GetContents[field.textViewer]; ptype: ROPE _ ChoiceButtons.GetSelectedButton[field.patternButton]; IF NOT Rope.Equal[contents, ""] AND NARROW[key, ATOM] # sortby THEN cursor _ LoganQuery.FilterEntries[input: cursor, pattern: contents, filter: NamedFilter[ptype], atype: NARROW[key]]; RETURN[quit: FALSE]; }; start, end: ROPE _ NIL; field: FormField; pattern, ptype: ROPE; cursor: LoganQuery.ComplexCursor; entry: LoganBerry.Entry; <

> field _ NARROW[RefTab.Fetch[form, sortby].val]; pattern _ ViewerTools.GetContents[field.textViewer]; ptype _ ChoiceButtons.GetSelectedButton[field.patternButton]; start _ OptimalStart[pattern, ptype]; <> cursor _ LoganQuery.GenerateEntries[db: db, key: sortby, start: start, end: end]; <> IF NOT Rope.Equal[pattern, ""] THEN cursor _ LoganQuery.FilterEntries[input: cursor, pattern: pattern, filter: NamedFilter[ptype], atype: sortby, stopIfNothingGreater: TRUE]; [] _ RefTab.Pairs[form, NewFilter]; <> tool.stop _ FALSE; entry _ LoganQuery.NextEntry[cursor]; WHILE entry # NIL AND NOT tool.stop DO [] _ PutEntry[entry]; entry _ LoganQuery.NextEntry[cursor]; ENDLOOP; LoganQuery.EndGenerate[cursor]; }; 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]; }; OptimalStart: PROC [pattern: ROPE, ptype: ROPE] RETURNS [start: ROPE] ~ { SELECT TRUE FROM Rope.Equal[ptype, "exact"] => { start _ pattern; }; Rope.Equal[ptype, "prefix"] => { start _ pattern; }; Rope.Equal[ptype, "wildcard"] => { start _ Rope.Substr[base: pattern, len: Rope.Index[s1: pattern, s2: "*"]]; }; Rope.Equal[ptype, "reg. exp."] => { i: INT _ Rope.SkipTo[s: pattern, skip: "\'#[^$*+(\\<{!"]; -- look for special chars IF NOT i = Rope.Length[pattern] AND Rope.Fetch[pattern, i] = '* THEN -- could be zero of previous char i _ i-1; start _ Rope.Substr[base: pattern, len: i]; }; Rope.Equal[ptype, "soundex"] => { start _ Rope.FromChar[Rope.Fetch[base: pattern, index: 0]]; }; ENDCASE => start _ NIL; }; NamedFilter: PROC [ptype: ROPE] RETURNS [LoganQuery.FilterProc] ~ { RETURN[SELECT TRUE FROM Rope.Equal[ptype, "exact"] => LoganQuery.Equal, Rope.Equal[ptype, "prefix"] => LoganQuery.Prefix, Rope.Equal[ptype, "wildcard"] => LoganQuery.Wildcard, Rope.Equal[ptype, "reg. exp."] => LoganQuery.RE, Rope.Equal[ptype, "soundex"] => LoganQuery.Soundex, ENDCASE => LoganQuery.Equal]; }; ReportLBError: PROC [ec: LoganBerry.ErrorCode, explanation: ROPE, v: Viewer] RETURNS [] ~ { TypeScript.Reset[v]; TypeScript.PutRope[v, Rope.Cat["Error: ", Atom.GetPName[ec], "  ", explanation]]; }; <> <> <> < errormsg _ Rope.Cat["Could not import Loganberry from ", instance];>> <<};>> <> < CONTINUE];};>> <> <> <<};>> PostRPCError: PROC[why: RPC.CallFailure, v: Viewer] RETURNS[] = { TypeScript.Reset[v]; TypeScript.PutRope[v, "Error: RPC failure."]; }; <> browserIcon _ Icons.NewIconFromFile[file: "LoganBerry.icons", n: 0 ! ANY => CONTINUE]; Commander.Register[key: "LoganBerryBrowser", proc: MakeBrowserTool, doc: "Create a LoganBerry browser." ]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <>