<> <> <> <> DIRECTORY Ascii USING [Lower, Upper], Atom USING [GetPName, MakeAtom], BasicTime USING [GMT, Period], ChoiceButtons USING [EnumTypeRef, BuildEnumTypeSelection, BuildTextPrompt, GetSelectedButton, UpdateChoiceButtons], Containers USING [ ChildXBound, ChildYBound, Container, Create ], Convert USING [Error, IntFromRope], FS USING [ComponentPositions, ExpandName, Position], Icons USING [ IconFlavor, NewIconFromFile ], IO USING [atom, BreakProc, EndOfStream, GetTokenRope, GetLineRope, TokenProc, GetChar, SkipWhitespace, PeekChar, GetRopeLiteral, Error, IDProc, STREAM, PutRope, PutF, PutFR, real, RIS, RopeFromROS, rope, ROS, time], Labels USING [Create, Label, Set], LoganBerryStub USING [AttributeType, AttributeValue, BuildIndices, Close, CompactLogs, DeleteEntry, Entry, EntryProc, Error, ErrorCode, Open, OpenDB, WriteEntry], LoganBerryStubExtras USING [Describe2, IndexInfo, SchemaInfo], LoganQuery USING [ComplexCursor, EndGenerate, Equal, FilterEntries, FilterProc, GenerateEntries, Prefix, NextEntry, RE, Soundex, Wildcard], Menus USING [AppendMenuEntry, ChangeNumberOfLines, ClickProc, CreateEntry, CreateMenu, GetNumberOfLines, InsertMenuEntry, Menu, MenuLine], MessageWindow USING [Append, Blink], Process USING [Abort, GetCurrent, InvalidProcess], RefTab USING [Ref, EachPairAction, Fetch, Pairs, Create, Store], Rope USING [Cat, Compare, Concat, Equal, Fetch, Find, FromChar, Index, Length, Replace, ROPE, Run, SkipTo, Substr, Translate, TranslatorType], Rules USING [ Create, Rule ], Tempus USING [Adjust, Parse, Precision, MakeRope, Unintelligible], TiogaButtons USING [CreateButton, CreateViewer, TiogaButtonProc], TypeScript USING [ Create, ChangeLooks, PutChar, PutRope ], ViewerBLT USING [ChangeNumberOfLines], ViewerClasses USING [ Viewer, ViewerClassRec, ViewerFlavor, ViewerRec ], ViewerEvents USING [ EventProc, RegisterEventProc ], ViewerOps USING [AddProp, CloseViewer, CreateViewer, MoveViewer, OpenIcon, PaintViewer], ViewerTools USING [GetContents, SetContents], LoganBerryBrowser; LoganBerryBrowserImpl: CEDAR PROGRAM IMPORTS Ascii, Atom, BasicTime, ChoiceButtons, Containers, Convert, FS, Icons, IO, Labels, LoganBerry: LoganBerryStub, LoganBerryExtras: LoganBerryStubExtras, LoganQuery, Menus, MessageWindow, Process, RefTab, Rope, Rules, Tempus, TiogaButtons, TypeScript, ViewerBLT, ViewerEvents, ViewerOps, ViewerTools EXPORTS LoganBerryBrowser = BEGIN <<>> <> <<>> ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; Viewer: TYPE = ViewerClasses.Viewer; BrowserTool: TYPE = LoganBerryBrowser.Tool ; FormField: TYPE = REF FormFieldRec; FormFieldRec: TYPE = RECORD [ textViewer: Viewer, patternButton: ChoiceButtons.EnumTypeRef, feedbackArea: Labels.Label ]; HistoryData: TYPE = REF HistoryDataRec; HistoryDataRec: TYPE = RECORD [ tool: BrowserTool, cmd: ROPE, form: LoganBerryBrowser.AttributePatterns, other: ROPE ]; <<>> <> browserIcon: Icons.IconFlavor _ tool; itemHeight: CARDINAL = 14; interItemHeight: CARDINAL = 5; ruleHeight: CARDINAL = 1; patternButtonWidth: CARDINAL = 100; patternHSpace: CARDINAL = 5; feedbackHSpace: CARDINAL = 350; historyHeight: CARDINAL = 100; patternChoices: LIST OF ROPE = LIST["exact", "prefix", "wildcard", "reg. exp.", "soundex", "subrange", "numrange", "daterange", "date", "DWIM"]; defaultPattern: ROPE _ "DWIM"; <<>> <> <<>> StopProc: Menus.ClickProc = TRUSTED { <<[parent: REF ANY, clientData: REF ANY _ NIL, mouseButton: Menus.MouseButton _ red, shift: BOOL _ FALSE, control: BOOL _ FALSE]>> tool: BrowserTool _ NARROW[clientData]; Process.Abort[tool.process ! Process.InvalidProcess => CONTINUE]; }; <<(client supplied menu procedures can be supplied; see below for defaults.)>> 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; }; }; DestroyProc: ViewerEvents.EventProc = { <<[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>> <<-- Does nothing at the moment>> <> < {ReportLBError[ec, explanation, tool]; CONTINUE}];>> }; <> <<>> MakeEntryForm: PROC [tool: BrowserTool] RETURNS [] ~ { tool.entryform _ RefTab.Create[]; FOR k: LIST OF LoganBerry.AttributeType _ tool.fields, k.rest WHILE k # NIL DO field: FormField _ NEW[FormFieldRec]; field.patternButton _ ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, buttonNames: patternChoices, default: defaultPattern, 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; field.feedbackArea _ Labels.Create[info: [parent: tool.details, wx: feedbackHSpace, wy: tool.height, ww: 1000, wh: 0, border: FALSE, scrollable: FALSE]]; 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 [] ~ { choices: LIST OF ROPE _ NIL; FOR i: LIST OF LoganBerryExtras.IndexInfo _ tool.dbInfo.indices, i.rest WHILE i#NIL DO choices _ CONS[Atom.GetPName[i.first.key], choices]; ENDLOOP; choices _ CONS["ANY", choices]; tool.height _ tool.height + interItemHeight; tool.sortButton _ ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, title: "Order by:", buttonNames: choices, default: "ANY", style: menuSelection --vs. flipThru--]; tool.queryFeedback _ Labels.Create[info: [parent: tool.details, wx: MAX[tool.sortButton.nextx, feedbackHSpace], wy: tool.height, ww: 1000, wh: 0, border: FALSE, scrollable: FALSE]]; tool.height _ tool.height + itemHeight + interItemHeight; }; ReadEntryForm: PUBLIC PROC [tool: BrowserTool] RETURNS [form: LoganBerryBrowser.AttributePatterns, orderBy: LoganBerry.AttributeType] ~ { 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 NOT Rope.Equal[text, ""] THEN { fv: LoganBerryBrowser.AttributePattern _ NEW[LoganBerryBrowser.AttributePatternRec]; fv.attr.type _ label; fv.attr.value _ text; fv.ptype _ ChoiceButtons.GetSelectedButton[field.patternButton]; IF form=NIL THEN form _ end _ LIST[fv] ELSE {end.rest _ LIST[fv]; end _ end.rest;}; }; Labels.Set[field.feedbackArea, NIL]; RETURN[quit: FALSE]; }; other: ROPE; end, otherPatterns: LoganBerryBrowser.AttributePatterns; form _ NIL; [] _ RefTab.Pairs[tool.entryform, NextField]; other _ ViewerTools.GetContents[tool.inputArea]; AddToHistory[tool, form, other]; otherPatterns _ ReadAttributePatterns[IO.RIS[other]]; form _ AppendPatterns[form, otherPatterns]; orderBy _ Atom.MakeAtom[ChoiceButtons.GetSelectedButton[tool.sortButton]]; IF orderBy = $ANY THEN orderBy _ NIL; Labels.Set[tool.queryFeedback, NIL]; }; RestoreEntryForm: PROC [tool: BrowserTool, form: LoganBerryBrowser.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: LoganBerryBrowser.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]; }; Labels.Set[field.feedbackArea, NIL, FALSE]; RETURN[quit: FALSE]; }; ChoiceButtons.UpdateChoiceButtons[tool.details, tool.sortButton, Atom.GetPName[form.first.attr.type]]; Labels.Set[tool.queryFeedback, NIL, FALSE]; [] _ RefTab.Pairs[tool.entryform, RestoreField]; ViewerTools.SetContents[tool.inputArea, other, FALSE]; ViewerOps.PaintViewer[viewer: tool.outer, hint: all]; }; ReportFeedback: PUBLIC PROC [category: ATOM, info: Rope.ROPE, tool: BrowserTool] RETURNS [] ~ { ff: FormField; info _ Rope.Cat["(",info,")"]; SELECT category FROM $QUERY => Labels.Set[tool.queryFeedback, info]; ENDCASE => { ff _ NARROW[RefTab.Fetch[tool.entryform, category].val]; IF ff#NIL THEN Labels.Set[ff.feedbackArea, info]; }; }; <<>> <> <<>> <> <> <<>> AddToHistory: PROC [tool: BrowserTool, form: LoganBerryBrowser.AttributePatterns, other: ROPE] RETURNS [] ~ { data: HistoryData = NEW[HistoryDataRec _ [tool, NIL, form, other]]; line: STREAM _ IO.ROS[]; 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]; }; <<>> <> <<>> 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]; }; ResetViewer: PROC [v: Viewer] RETURNS [] ~ { v.class.init[v]; }; <<>> <> CreateTool: PUBLIC PROC [db: LoganBerry.OpenDB, tool: BrowserTool] = { innerInfo: ViewerClasses.ViewerRec; shortname: ROPE; cp: FS.ComponentPositions; <> tool.db _ dbInfoCache.db _ db; tool.dbInfo _ dbInfoCache.dbInfo _ LoganBerryExtras.Describe2[db: tool.db]; SetDefaults[tool]; <> [tool.dbInfo.dbName, cp] _ FS.ExpandName[tool.dbInfo.dbName]; shortname _ Rope.Substr[base: tool.dbInfo.dbName, start: cp.base.start, len: cp.base.length]; <> Menus.InsertMenuEntry[menu: tool.menu, entry: Menus.CreateEntry[name: "STOP!", proc: StopProc, clientData: tool]]; Menus.AppendMenuEntry[menu: tool.menu, entry: Menus.CreateEntry[name: "History", proc: HistoryProc, clientData: tool]]; Menus.AppendMenuEntry[menu: tool.menu, entry: Menus.CreateEntry[name: "Details", proc: DetailsProc, clientData: tool]]; tool.outer _ Containers.Create[info: [ name: Rope.Concat["LoganBerry Browser: ", tool.dbInfo.dbName], icon: tool.icon, 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]; <> innerInfo _ [ name: "LoganBerry Browser output", parent: tool.outer, wx: 0, wy: tool.height, ww: 9999, wh: 9999, border: FALSE]; tool.inner _ SELECT tool.innerFlavor FROM $Typescript => TypeScript.Create[info: innerInfo], ENDCASE => ViewerOps.CreateViewer[flavor: tool.innerFlavor, info: innerInfo]; 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 <> <> ViewerOps.CloseViewer[viewer: tool.outer]; ViewerOps.OpenIcon[icon: tool.outer]; }; PrintEntry: PUBLIC PROC [entry: LoganBerryStub.Entry, tool: BrowserTool] = { <> 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]; }; <<>> <> SyntaxError: PUBLIC ERROR [explanation: ROPE _ NIL] = CODE; ReadAttributePatterns: PUBLIC PROC [s: IO.STREAM] RETURNS [ap: LoganBerryBrowser.AttributePatterns] ~ { ReadAttributePattern: PROC [s: STREAM] RETURNS [a: LoganBerryBrowser.AttributePattern] ~ { <> ENABLE IO.EndOfStream => ERROR SyntaxError["unexpected end of input"]; ch: CHAR; token: ROPE; token _ IO.GetTokenRope[s, IO.TokenProc ! IO.EndOfStream => GOTO none].token; a _ NEW[LoganBerryBrowser.AttributePatternRec]; a.attr.type _ Atom.MakeAtom[token]; ch _ IO.GetChar[s]; -- attribute separation char or "(" IF ch = '( THEN { -- read pattern type a.ptype _ IO.GetTokenRope[s, IO.TokenProc].token; ch _ IO.GetChar[s]; IF ch # ') THEN ERROR SyntaxError[Rope.Concat["unmatched ()'s: last read ", a.ptype]]; ch _ IO.GetChar[s]; }; IF ch # ': THEN ERROR SyntaxError[Rope.Concat["missing colon: last read ", a.ptype]]; [] _ IO.SkipWhitespace[stream: s, flushComments: FALSE]; IF IO.PeekChar[s] = '" THEN { a.attr.value _ IO.GetRopeLiteral[s ! IO.Error => ERROR SyntaxError["Malformed rope literal"]]; } ELSE a.attr.value _ IO.GetTokenRope[s, IO.IDProc].token; EXITS none => RETURN[NIL]; }; <> a: LoganBerryBrowser.AttributePattern; endOfAp: LoganBerryBrowser.AttributePatterns _ NIL; a _ ReadAttributePattern[s]; WHILE a # NIL DO IF endOfAp = NIL THEN ap _ endOfAp _ LIST[a] ELSE { endOfAp.rest _ LIST[a]; endOfAp _ endOfAp.rest; }; a _ ReadAttributePattern[s]; ENDLOOP; }; WriteAttributePatterns: PUBLIC PROC [s: IO.STREAM, ap: LoganBerryBrowser.AttributePatterns] RETURNS [] ~ { WriteAttributePattern: PROC [s: IO.STREAM, a: LoganBerryBrowser.AttributePattern] RETURNS [] ~ { IO.PutRope[s, Atom.GetPName[a.attr.type]]; IF a.ptype # NIL THEN IO.PutF[s, "(%g)", IO.rope[a.ptype]]; IO.PutF[s, ": ""%g"" ", IO.rope[a.attr.value]]; }; FOR p: LoganBerryBrowser.AttributePatterns _ ap, p.rest WHILE p # NIL DO WriteAttributePattern[s, p.first]; ENDLOOP; }; PatternsToEntry: PUBLIC PROC [ap: LoganBerryBrowser.AttributePatterns] RETURNS [entry: LoganBerry.Entry] ~ { endOfEntry: LoganBerry.Entry _ NIL; FOR p: LoganBerryBrowser.AttributePatterns _ ap, p.rest WHILE p # NIL DO IF endOfEntry = NIL THEN entry _ endOfEntry _ LIST[p.first.attr] ELSE { endOfEntry.rest _ LIST[p.first.attr]; endOfEntry _ endOfEntry.rest; }; ENDLOOP; }; EntryToPatterns: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [ap: LoganBerryBrowser.AttributePatterns] ~ { pattern: LoganBerryBrowser.AttributePattern; endOfPattern: LoganBerryBrowser.AttributePatterns _ NIL; FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO pattern _ NEW[LoganBerryBrowser.AttributePatternRec _ [attr: e.first]]; IF endOfPattern = NIL THEN ap _ endOfPattern _ LIST[pattern] ELSE { endOfPattern.rest _ LIST[pattern]; endOfPattern _ endOfPattern.rest; }; ENDLOOP; }; AppendPatterns: PROC [p1, p2: LoganBerryBrowser.AttributePatterns] RETURNS [LoganBerryBrowser.AttributePatterns] ~ { temp: LoganBerryBrowser.AttributePatterns _ p1; IF p1 = NIL THEN RETURN[p2]; UNTIL temp.rest = NIL DO temp _ temp.rest ENDLOOP; temp.rest _ p2; RETURN[p1]; }; <> warningThreshold: REAL = 0.75; -- give warning if 3/4 of the database must be searched QueryWarning: PUBLIC SIGNAL = CODE; <> FilteredQuery: PUBLIC PROC [db: LoganBerry.OpenDB, patterns: LoganBerryBrowser.AttributePatterns, proc: LoganBerry.EntryProc, baseIndex: LoganBerry.AttributeType _ NIL, feedback: LoganBerryBrowser.FeedbackProc _ NIL] RETURNS [] ~ { <> start, end: ROPE _ NIL; qCost: REAL _ 1.0; computeBase: BOOLEAN _ baseIndex = NIL; cursor: LoganQuery.ComplexCursor; entry: LoganBerry.Entry; IF patterns = NIL THEN RETURN; <

> FOR p: LoganBerryBrowser.AttributePatterns _ patterns, p.rest WHILE p # NIL DO IF computeBase THEN { tStart, tEnd: ROPE; tCost: REAL; iType: ATOM _ GetIndexType[db, p.first.attr.type]; IF iType = $notAnIndex THEN LOOP; [tStart, tEnd] _ BaseStartEnd[pattern: p.first.attr.value, ptype: p.first.ptype, itype: iType]; tCost _ QueryCost[tStart, tEnd, iType]; IF tCost <= qCost THEN { -- found a better base index start _ tStart; end _ tEnd; qCost _ tCost; baseIndex _ p.first.attr.type; }; } ELSE { IF p.first.attr.type = baseIndex THEN { iType: ATOM _ GetIndexType[db, p.first.attr.type]; IF iType = $notAnIndex THEN baseIndex _ NIL ELSE { [start, end] _ BaseStartEnd[pattern: p.first.attr.value, ptype: p.first.ptype, itype: iType]; qCost _ QueryCost[start, end, iType]; }; EXIT; -- got base index so no need to go on }; }; ENDLOOP; IF baseIndex = NIL THEN ERROR LoganBerry.Error[$NoIndex, "No suitable base index"]; feedback[category: $QUERY, info: IO.PutFR["%g - %3.2f", IO.atom[baseIndex], IO.real[qCost]]]; <> IF qCost > warningThreshold THEN SIGNAL QueryWarning; <> cursor _ LoganQuery.GenerateEntries[db: db, key: baseIndex, start: start, end: end]; <> FOR p: LoganBerryBrowser.AttributePatterns _ patterns, p.rest WHILE p # NIL DO pattern: LoganBerryBrowser.AttributePattern = p.first; IF NOT Rope.Equal[pattern.attr.value, ""] THEN { filter: LoganQuery.FilterProc; info: Rope.ROPE; [filter, info] _ AnalyzePattern[pattern]; IF info # NIL THEN feedback[pattern.attr.type, info]; cursor _ LoganQuery.FilterEntries[input: cursor, pattern: pattern.attr.value, filter: filter, atype: pattern.attr.type, stopIfNothingGreater: FALSE]; }; ENDLOOP; <> entry _ LoganQuery.NextEntry[cursor]; WHILE entry # NIL DO IF NOT proc[entry] THEN EXIT; entry _ LoganQuery.NextEntry[cursor]; ENDLOOP; LoganQuery.EndGenerate[cursor]; }; dbInfoCache: RECORD[ -- simple cache with one entry db: LoganBerry.OpenDB, dbInfo: LoganBerryExtras.SchemaInfo _ NIL ]; GetIndexType: PROC [db: LoganBerry.OpenDB, index: LoganBerry.AttributeType] RETURNS [type: ATOM] ~ { IF dbInfoCache.dbInfo = NIL OR dbInfoCache.db # db THEN dbInfoCache.dbInfo _ LoganBerryExtras.Describe2[db: db]; FOR i: LIST OF LoganBerryExtras.IndexInfo _ dbInfoCache.dbInfo.indices, i.rest WHILE i#NIL DO IF i.first.key = index THEN RETURN[i.first.order]; ENDLOOP; RETURN[$notAnIndex]; }; QueryCost: PROC [start, end: ROPE, itype: ATOM _ $lex] RETURNS [est: REAL _ 1.0] ~ { <> N: NAT = 5; run: INT; sChar, eChar: CHAR; IF end=NIL THEN RETURN[1.0]; IF start=NIL THEN start _ " "; SELECT itype FROM $lex, $ascii => { run _ Rope.Run[s1: start, s2: end, case: itype=$ascii]; IF run > N THEN RETURN[0.0]; -- the query has negligible cost est _ 1.0; THROUGH [1..run] DO est _ est*0.01; ENDLOOP; -- est _ 1/100run sChar _ IF Rope.Length[start] <= run THEN ' ELSE Rope.Fetch[start, run]; eChar _ IF Rope.Length[end] <= run THEN ' ELSE Rope.Fetch[end, run]; IF itype=$lex THEN { sChar _ Ascii.Upper[sChar]; eChar _ Ascii.Upper[eChar]; }; est _ est*MIN[eChar-sChar,100]*0.01; }; $gmt => { startDate, endDate: BasicTime.GMT; year: REAL _ 31536000.0; startDate _ Tempus.Parse[rope: start, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; endDate _ Tempus.Parse[rope: end, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; est _ BasicTime.Period[from: startDate, to: endDate]/year; -- assume one year is complete database IF est < 0 OR est > 1.0 THEN est _ 1.0; EXITS BadPattern => RETURN[1.0]; }; ENDCASE => RETURN[0.5]; -- don't know the index layout so assume half the index will be needed on average }; BaseStartEnd: PROC [pattern: ROPE, ptype: ROPE, itype: ATOM _ $lex] RETURNS [start, end: ROPE] ~ { <> ENABLE SyntaxError => {start _ end _ NIL; CONTINUE;}; -- raised by ParseSubrange Bump: PROC [old: ROPE] RETURNS [new: ROPE] ~ INLINE { last: INT = Rope.Length[old] - 1; new _ IF last >= 0 THEN Rope.Replace[base: old, start: last, len: 1, with: Rope.FromChar[SUCC[Rope.Fetch[old, last]]]] ELSE NIL; }; Upper: Rope.TranslatorType = { <<[old: CHAR] RETURNS [new: CHAR]>> new _ Ascii.Upper[old]; }; Lower: Rope.TranslatorType = { <<[old: CHAR] RETURNS [new: CHAR]>> new _ Ascii.Lower[old]; }; IF Rope.Equal[ptype, "DWIM", FALSE] THEN ptype _ DWIM[pattern]; SELECT itype FROM $lex => { SELECT TRUE FROM Rope.Equal[ptype, "exact", FALSE], Rope.Equal[ptype, "equal", FALSE] => { start _ pattern; end _ pattern; }; Rope.Equal[ptype, "prefix", FALSE] => { start _ pattern; end _ Bump[start]; }; Rope.Equal[ptype, "wildcard", FALSE] => { start _ Rope.Substr[base: pattern, len: Rope.Index[s1: pattern, s2: "*"]]; end _ Bump[start]; }; Rope.Equal[ptype, "reg. exp.", FALSE], Rope.Equal[ptype, "re", FALSE] => { 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]; end _ Bump[start]; }; Rope.Equal[ptype, "soundex", FALSE] => { start _ Rope.FromChar[Rope.Fetch[base: pattern, index: 0]]; end _ Bump[start]; }; Rope.Equal[ptype, "subrange", FALSE] => { [start, end] _ ParseSubrange[pattern]; }; Rope.Equal[ptype, "numrange", FALSE] => { <> s, e: ROPE; [s, e] _ ParseSubrange[pattern ! SyntaxError => {start _ NIL; CONTINUE}]; IF Rope.Length[s] = Rope.Length[e] THEN { start _ Rope.Substr[base: s, len: Rope.Run[s1: s, s2: e]]; end _ Bump[start]; } ELSE start _ end _ NIL; -- can do nothing intelligent, e.g. 300-3000 }; Rope.Equal[ptype, "daterange", FALSE] => { start _ end _ NIL; -- can do nothing intelligent }; Rope.Equal[ptype, "date", FALSE] => { start _ end _ NIL; -- can do nothing intelligent }; ENDCASE => start _ end _ NIL; }; $ascii => { start _ BaseStartEnd[Rope.Translate[base: pattern, translator: Upper], ptype, $lex].start; end _ BaseStartEnd[Rope.Translate[base: pattern, translator: Lower], ptype, $lex].end; }; $gmt => { SELECT TRUE FROM Rope.Equal[ptype, "date", FALSE] => { patternDate: BasicTime.GMT; patternPrecision: Tempus.Precision; [patternDate, patternPrecision] _ Tempus.Parse[rope: pattern, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern]; start _ Tempus.MakeRope[time: patternDate, precision: patternPrecision]; [patternDate, patternPrecision] _ SELECT patternPrecision FROM years => Tempus.Adjust[years: 1, baseTime: patternDate], months => Tempus.Adjust[months: 1, baseTime: patternDate], days => Tempus.Adjust[days: 1, baseTime: patternDate], hours => Tempus.Adjust[hours: 1, baseTime: patternDate], minutes => Tempus.Adjust[minutes: 1, baseTime: patternDate], seconds => Tempus.Adjust[seconds: 1, baseTime: patternDate], ENDCASE => Tempus.Adjust[seconds: 1, baseTime: patternDate]; end _ Tempus.MakeRope[time: patternDate, precision: patternPrecision]; EXITS BadPattern => start _ end _ NIL; }; Rope.Equal[ptype, "daterange", FALSE] => { patternDate: BasicTime.GMT; patternPrecision: Tempus.Precision; [start, end] _ ParseSubrange[pattern]; [patternDate, patternPrecision] _ Tempus.Parse[rope: start, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern]; start _ Tempus.MakeRope[time: patternDate, precision: patternPrecision]; [patternDate, patternPrecision] _ Tempus.Parse[rope: end, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern]; end _ Tempus.MakeRope[time: patternDate, precision: patternPrecision]; EXITS BadPattern => start _ end _ NIL; }; ENDCASE => start _ end _ NIL; }; $int => { SELECT TRUE FROM Rope.Equal[ptype, "exact", FALSE], Rope.Equal[ptype, "equal", FALSE] => start _ end _ pattern; Rope.Equal[ptype, "intrange", FALSE] => [start, end] _ ParseSubrange[pattern]; ENDCASE => start _ end _ NIL; }; ENDCASE => start _ end _ NIL; -- search complete database }; AnalyzePattern: PROC [p: LoganBerryBrowser.AttributePattern] RETURNS [filter: LoganQuery.FilterProc, info: Rope.ROPE _ NIL] ~ { start, end: Rope.ROPE; SELECT TRUE FROM Rope.Equal[p.ptype, "exact", FALSE], Rope.Equal[p.ptype, "equal", FALSE] => { filter _ LoganQuery.Equal; }; Rope.Equal[p.ptype, "prefix", FALSE] => { filter _ LoganQuery.Prefix; }; Rope.Equal[p.ptype, "wildcard", FALSE] => { filter _ LoganQuery.Wildcard; }; Rope.Equal[p.ptype, "reg. exp.", FALSE], Rope.Equal[p.ptype, "re", FALSE] => { filter _ LoganQuery.RE; }; Rope.Equal[p.ptype, "soundex", FALSE] => { filter _ LoganQuery.Soundex; }; Rope.Equal[p.ptype, "subrange", FALSE] => { filter _ Subrange; [start, end] _ ParseSubrange[p.attr.value ! SyntaxError => GOTO BadPattern]; IF Rope.Compare[s1: start, s2: end, case: FALSE] = greater THEN GOTO BadPattern; EXITS BadPattern => info _ "NOT A SUBRANGE"; }; Rope.Equal[p.ptype, "numrange", FALSE] => { startInt, endInt: INT; filter _ NumSubrange; [start, end] _ ParseSubrange[p.attr.value ! SyntaxError => GOTO BadPattern]; startInt _ Convert.IntFromRope[start ! Convert.Error => GOTO BadPattern]; endInt _ Convert.IntFromRope[end ! Convert.Error => GOTO BadPattern]; IF startInt > endInt THEN GOTO BadPattern; EXITS BadPattern => info _ "NOT AN INTEGER RANGE"; }; Rope.Equal[p.ptype, "daterange", FALSE] => { startDate, endDate: BasicTime.GMT; filter _ DateSubrange; [start, end] _ ParseSubrange[p.attr.value ! SyntaxError => GOTO BadPattern]; startDate _ Tempus.Parse[rope: start, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; endDate _ Tempus.Parse[rope: end, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; IF BasicTime.Period[from: startDate, to: endDate] < 0 THEN GOTO BadPattern; info _ IO.PutFR["%g-%g", IO.time[startDate], IO.time[endDate]]; EXITS BadPattern => info _ "NOT A DATE RANGE"; }; Rope.Equal[p.ptype, "date", FALSE] => { patternDate: BasicTime.GMT; patternPrecision: Tempus.Precision; filter _ DateAndTime; [patternDate, patternPrecision] _ Tempus.Parse[rope: p.attr.value, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern]; info _ Tempus.MakeRope[time: patternDate, precision: patternPrecision]; EXITS BadPattern => info _ "NOT A DATE AND TIME"; }; Rope.Equal[p.ptype, "DWIM", FALSE] => { p.ptype _ DWIM[p.attr.value]; [filter, info] _ AnalyzePattern[p]; -- recursive call info _ Rope.Cat["using ", p.ptype, "...", info]; }; ENDCASE => { filter _ LoganQuery.Equal; }; }; DWIM: PROC [pattern: ROPE] RETURNS [ptype: ROPE _ "prefix"] ~ { <> start, end: ROPE; ok: BOOLEAN _ TRUE; [start, end] _ ParseSubrange[pattern ! SyntaxError => {ok _ FALSE; CONTINUE}]; IF ok THEN { -- determine what type of subrange ok _ TRUE; [] _ Convert.IntFromRope[start ! Convert.Error => {ok _ FALSE; CONTINUE}]; [] _ Convert.IntFromRope[end ! Convert.Error => {ok _ FALSE; CONTINUE}]; IF ok THEN RETURN["numrange"]; ok _ TRUE; [] _ Tempus.Parse[rope: start, search: FALSE ! Tempus.Unintelligible => {ok _ FALSE; CONTINUE}]; [] _ Tempus.Parse[rope: end, search: FALSE ! Tempus.Unintelligible => {ok _ FALSE; CONTINUE}]; IF ok THEN RETURN["daterange"]; RETURN["subrange"]; } ELSE { -- not a subrange IF Rope.Find[pattern, "*"] # -1 THEN RETURN["wildcard"]; ok _ TRUE; [] _ Tempus.Parse[rope: pattern, search: FALSE ! Tempus.Unintelligible => {ok _ FALSE; CONTINUE}]; IF ok THEN RETURN["date"]; RETURN["prefix"]; }; }; <<>> <> <> srCache: RECORD [ -- very simple cache with one entry lastr: ROPE _ NIL, start, end: ROPE ]; nsrCache: RECORD [ -- very simple cache with one entry lastr: ROPE _ NIL, start, end: INT ]; dsrCache: RECORD [ -- very simple cache with one entry lastr: ROPE _ NIL, start, end: BasicTime.GMT ]; dtCache: RECORD [ -- very simple cache with one entry lastr: ROPE _ NIL, time: BasicTime.GMT, precision: Tempus.Precision ]; ParseSubrange: PROC [r: ROPE] RETURNS [start, end: ROPE] ~ { <> ENABLE IO.EndOfStream, IO.Error => ERROR SyntaxError["Ill-formed subrange"]; ToDash: IO.BreakProc = { <<[char: CHAR] RETURNS [IO.CharClass]>> RETURN[SELECT char FROM '- => sepr, ENDCASE => other]; }; s: IO.STREAM; IF r=srCache.lastr THEN RETURN[srCache.start, srCache.end]; s _ IO.RIS[r]; start _ IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetTokenRope[s, ToDash].token; IF IO.GetChar[s] # '- THEN ERROR SyntaxError["Not a subrange"]; end _ IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetLineRope[s]; srCache.lastr _ r; srCache.start _ start; srCache.end _ end; }; Subrange: LoganQuery.FilterProc ~ { -- should be in LoganQuery? <<[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]>> <> start, end: Rope.ROPE; <> [start, end] _ ParseSubrange[pattern ! SyntaxError => GOTO BadPattern]; IF Rope.Compare[s1: start, s2: end, case: FALSE] = greater THEN GOTO BadPattern; <> SELECT Rope.Compare[s1: value, s2: start, case: FALSE] FROM less => match _ FALSE; equal => match _ TRUE; greater => SELECT Rope.Compare[s1: Rope.Substr[value, 0, Rope.Length[end]], s2: end, case: FALSE] FROM less => match _ TRUE; equal => match _ TRUE; greater => {match _ FALSE; nothingGreater _ TRUE} ENDCASE => ERROR; ENDCASE => ERROR; EXITS BadPattern => RETURN[match: FALSE, nothingGreater: TRUE]; }; NumSubrange: LoganQuery.FilterProc ~ { -- should be in LoganQuery? <<[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]>> <> start, end: Rope.ROPE; startInt, endInt, valueInt: INT; <> IF pattern=nsrCache.lastr THEN { -- get from cache startInt _ nsrCache.start; endInt _ nsrCache.end; } ELSE { -- parse pattern and keep for future use [start, end] _ ParseSubrange[pattern ! SyntaxError => GOTO BadPattern]; startInt _ Convert.IntFromRope[start ! Convert.Error => GOTO BadPattern]; endInt _ Convert.IntFromRope[end ! Convert.Error => GOTO BadPattern]; IF startInt > endInt THEN GOTO BadPattern; nsrCache.lastr _ pattern; nsrCache.start _ startInt; nsrCache.end _ endInt; }; valueInt _ Convert.IntFromRope[value ! Convert.Error => GOTO BadValue]; <> match _ startInt <= valueInt AND valueInt <= endInt; EXITS BadPattern => RETURN[match: FALSE, nothingGreater: TRUE]; BadValue => RETURN[match: FALSE, nothingGreater: FALSE]; }; DateSubrange: LoganQuery.FilterProc ~ { -- should be in LoganQuery? <<[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]>> <> start, end: Rope.ROPE; startDate, endDate, valueDate: BasicTime.GMT; <> IF pattern=dsrCache.lastr THEN { -- get from cache startDate _ dsrCache.start; endDate _ dsrCache.end; } ELSE { -- parse pattern and keep for future use [start, end] _ ParseSubrange[pattern ! SyntaxError => GOTO BadPattern]; startDate _ Tempus.Parse[rope: start, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; endDate _ Tempus.Parse[rope: end, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern].time; IF BasicTime.Period[from: startDate, to: endDate] < 0 THEN GOTO BadPattern; dsrCache.lastr _ pattern; dsrCache.start _ startDate; dsrCache.end _ endDate; }; valueDate _ Tempus.Parse[rope: value, search: FALSE ! Tempus.Unintelligible => GOTO BadValue].time; <> match _ BasicTime.Period[from: startDate, to: valueDate] >= 0 AND BasicTime.Period[from: valueDate, to: endDate] >= 0; EXITS BadPattern => RETURN[match: FALSE, nothingGreater: TRUE]; BadValue => RETURN[match: FALSE, nothingGreater: FALSE]; }; DateAndTime: LoganQuery.FilterProc ~ { -- should be in LoganQuery? <<[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]>> <> patternDate, valueDate: BasicTime.GMT; patternPrecision: Tempus.Precision; <> IF pattern=dtCache.lastr THEN { -- get from cache patternDate _ dtCache.time; patternPrecision _ dtCache.precision; } ELSE { -- parse pattern and keep for future use [patternDate, patternPrecision] _ Tempus.Parse[rope: pattern, search: FALSE ! Tempus.Unintelligible => GOTO BadPattern]; dtCache.lastr _ pattern; dtCache.time _ patternDate; dtCache.precision _ patternPrecision; }; valueDate _ Tempus.Parse[rope: value, search: FALSE ! Tempus.Unintelligible => GOTO BadValue].time; <> valueDate _ Tempus.Adjust[baseTime: valueDate, precisionOfResult: patternPrecision].time; match _ BasicTime.Period[from: patternDate, to: valueDate] = 0; EXITS BadPattern => RETURN[match: FALSE, nothingGreater: TRUE]; BadValue => RETURN[match: FALSE, nothingGreater: FALSE]; }; <<>> <> Data: TYPE ~ REF DataRec; -- default client data DataRec: TYPE ~ RECORD[ lastDeletes: LIST OF LoganBerry.Entry _ NIL -- entries recently deleted ]; SetDefaults: PROC [tool: BrowserTool] RETURNS [] ~ { IF tool.menu = NIL THEN { tool.menu _ StandardMainMenu[tool]; tool.clientData _ NEW[DataRec]; }; IF tool.innerFlavor = NIL THEN tool.innerFlavor _ $TypeScript; IF tool.icon = unInit THEN tool.icon _ browserIcon; IF tool.fields = NIL THEN tool.fields _ IndexKeys[tool]; }; IndexKeys: PROC [tool: BrowserTool] RETURNS [fields: LIST OF LoganBerry.AttributeType] ~ { tail: LIST OF LoganBerry.AttributeType _ NIL; FOR i: LIST OF LoganBerryExtras.IndexInfo _ tool.dbInfo.indices, i.rest WHILE i#NIL DO IF tail#NIL THEN {tail.rest _ LIST[i.first.key]; tail _ tail.rest;} ELSE {fields _ tail _ LIST[i.first.key];} ENDLOOP; }; StandardMainMenu: PROC [tool: BrowserTool] RETURNS [menu: Menus.Menu] ~ { 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 ]; }; menu _ Menus.CreateMenu[lines: 2]; <<--first line-->> <> AppendMenu[menu, "Browse", BrowseProc]; AppendMenu[menu, "Update", UpdateProc]; AppendMenu[menu, "Delete", DeleteProc, 0, TRUE]; AppendMenu[menu, "UnDelete", UnDeleteProc, 0, TRUE]; <> <> AppendMenu[menu, "AdminOps", AdminOpsProc]; <<--second line-->> AppendMenu[menu, "Open", OpenProc, 1]; AppendMenu[menu, "Close", CloseProc, 1, TRUE]; AppendMenu[menu, "BuildIndices", BuildIndicesProc, 1, TRUE]; AppendMenu[menu, "CompactLogs", CompactLogsProc, 1, 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 ResetViewer[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]; IF mouseButton # blue THEN ResetViewer[tool.inner]; 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 ResetViewer[tool.inner]; DoOp[$LBDelete, tool]; }; UnDeleteProc: 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 ResetViewer[tool.inner]; DoOp[$LBUnDelete, tool]; }; 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.dbInfo.dbName ! LoganBerry.Error => {ReportLBError[ec, explanation, tool]; 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]; 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]; 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]; CONTINUE}]; }; DoOp: PROC [cmd: ATOM, tool: BrowserTool] RETURNS [] ~ { ENABLE { LoganBerry.Error => {ReportLBError[ec, explanation, tool]; CONTINUE}; QueryWarning => {MessageWindow.Append[message: "Browsing complete database...", clearFirst: TRUE]; MessageWindow.Blink[]; RESUME}; ABORTED => GOTO Aborted; }; PutEntry: LoganBerry.EntryProc = { <<[entry: LoganBerry.Entry] RETURNS [continue: BOOL]>> PrintEntry[entry, tool]; RETURN[TRUE]; }; DeleteEntry: LoganBerry.EntryProc = { <<[entry: LoganBerry.Entry] RETURNS [continue: BOOL]>> LoganBerry.DeleteEntry[db: tool.db, key: primaryKey, value: GetAttributeValue[entry, primaryKey]]; data.lastDeletes _ CONS[entry, data.lastDeletes]; PrintEntry[entry, tool]; RETURN[TRUE]; }; Feedback: LoganBerryBrowser.FeedbackProc ~ { <<[category: ATOM, info: Rope.ROPE] RETURNS []>> ReportFeedback[category, info, tool]; }; form: LoganBerryBrowser.AttributePatterns; primaryKey, base: LoganBerry.AttributeType; entry: LoganBerry.Entry; data: Data _ NARROW[tool.clientData]; TRUSTED {tool.process _ LOOPHOLE[Process.GetCurrent[], PROCESS];}; IF cmd # $LBUnDelete THEN [form, base] _ ReadEntryForm[tool ! SyntaxError => {ReportLBError[$MalformedInput, explanation, tool]; CONTINUE}]; <> SELECT cmd FROM $LBQuery => { FilteredQuery[db: tool.db, patterns: form, proc: PutEntry, baseIndex: base, feedback: Feedback]; }; $LBWrite => { entry _ PatternsToEntry[form]; LoganBerry.WriteEntry[db: tool.db, entry: entry]; PrintEntry[entry, tool]; }; $LBDelete => { primaryKey _ tool.dbInfo.indices.first.key; data.lastDeletes _ NIL; TypeScript.PutRope[tool.inner, "\n-- Deleting...\n"]; FilteredQuery[db: tool.db, patterns: form, proc: DeleteEntry, baseIndex: base, feedback: Feedback]; TypeScript.PutRope[tool.inner, "\n-- Done.\n"]; }; $LBUnDelete => { TypeScript.PutRope[tool.inner, "\n-- UnDeleting...\n"]; FOR l: LIST OF LoganBerry.Entry _ data.lastDeletes, l.rest WHILE l#NIL DO LoganBerry.WriteEntry[db: tool.db, entry: l.first ! LoganBerry.Error => {ReportLBError[ec, explanation, tool]; CONTINUE};]; PrintEntry[l.first, tool]; ENDLOOP; TypeScript.PutRope[tool.inner, "\n-- Done.\n"]; data.lastDeletes _ NIL; -- can't undo an undelete }; ENDCASE => NULL; EXITS Aborted => TypeScript.PutRope[tool.inner, "\n-- Aborted.\n"]; }; 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, tool: BrowserTool] RETURNS [] ~ { TypeScript.PutRope[tool.inner, IO.PutFR["ERROR: %g - %g", IO.atom[ec], IO.rope[explanation]]]; }; <<>> <> browserIcon _ Icons.NewIconFromFile[file: "LoganBerry.icons", n: 0 ! ANY => CONTINUE]; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>> <<>> <<>> <> <> <<>> <<>> <> <> <<>>