LoganBerryBrowserImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Terry, March 4, 1987 10:48:27 am PST
A tool for interactively browsing LoganBerry databases.
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
Types
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
];
Viewer layout
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";
Command menu
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
tool: BrowserTool ← NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $BrowserTool]];
LoganBerry.Close[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool]; CONTINUE}];
};
Entry form
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];
};
};
History viewer
The History viewer contains lines representing commands that could have been typed to a commandTool to achieve the same result as the operations invoked via the browser tool.
Each of these lines is a TiogaButton that, when buttoned, causes the entry form to be filled in with the various values.
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]
Left mouse button => restore the entry form; Middle => restore form and re-execute (not currently implemented).
data: HistoryData ← NARROW[clientData];
RestoreEntryForm[data.tool, data.form, data.other];
};
Misc. viewer stuff
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];
};
Create main tool
CreateTool:
PUBLIC PROC [db: LoganBerry.OpenDB, tool: BrowserTool] = {
innerInfo: ViewerClasses.ViewerRec;
shortname: ROPE;
cp: FS.ComponentPositions;
initialize tool
tool.db ← dbInfoCache.db ← db;
tool.dbInfo ← dbInfoCache.dbInfo ← LoganBerryExtras.Describe2[db: tool.db];
SetDefaults[tool];
find short database name
[tool.dbInfo.dbName, cp] ← FS.ExpandName[tool.dbInfo.dbName];
shortname ← Rope.Substr[base: tool.dbInfo.dbName, start: cp.base.start, len: cp.base.length];
create command section
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];
create input form
tool.details ← Containers.Create[info: [
parent: tool.outer,
ww: 1000,
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];
create history viewer
tool.history ← TiogaButtons.CreateViewer[info: [
parent: tool.outer,
wy: tool.height,
ww: 1000,
wh: historyHeight,
border: TRUE]];
Containers.ChildXBound[tool.outer, tool.history]; -- constrain rule to be width of parent
HideViewer[tool.history];
create output browser
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
Try to get viewer to initially echo typed input
ViewerOps.PaintViewer[viewer: tool.outer, hint: all];
ViewerOps.CloseViewer[viewer: tool.outer];
ViewerOps.OpenIcon[icon: tool.outer];
};
PrintEntry:
PUBLIC
PROC [entry: LoganBerryStub.Entry, tool: BrowserTool] = {
Write entry in browser's typescript viewer.
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];
};
Attribute patterns
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] ~ {
An attribute pattern is of the form: atype(ptype): avalue. The ptype is optional, and there may be whitespace preceeding the avalue. The avalue can be either a token or rope literal.
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];
};
Read attribute patterns until there are no more and build up a list of them.
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];
};
Query execution
warningThreshold: REAL = 0.75; -- give warning if 3/4 of the database must be searched
QueryWarning:
PUBLIC
SIGNAL =
CODE;
This signal is raised by FilteredQuery if the estimated query cost exceeds the warningThreshold specified above (i.e. the query will take a potentially long time); this signal can be resumed.
FilteredQuery:
PUBLIC
PROC [db: LoganBerry.OpenDB, patterns: LoganBerryBrowser.AttributePatterns, proc: LoganBerry.EntryProc, baseIndex: LoganBerry.AttributeType ←
NIL, feedback: LoganBerryBrowser.FeedbackProc ←
NIL]
RETURNS [] ~ {
Retrieves entries in the LoganBerry database that match the attribute patterns and calls the given procedure for each one. The baseIndex parameter governs which attribute type is used as the base index for the query; for baseIndex=NIL, an index is chosen that attempts to optimize the execution of the query (use this unless you really care about the order in which database entries are retrieved).
start, end: ROPE ← NIL;
qCost: REAL ← 1.0;
computeBase: BOOLEAN ← baseIndex = NIL;
cursor: LoganQuery.ComplexCursor;
entry: LoganBerry.Entry;
IF patterns = NIL THEN RETURN;
figure out where to start and end in database to save work, and pick a "good" base index if necessary
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]]];
warn the caller if the query will search the complete database; the caller can resume execution or unwind to abort the query
IF qCost > warningThreshold THEN SIGNAL QueryWarning;
simple base query
cursor ← LoganQuery.GenerateEntries[db: db, key: baseIndex, start: start, end: end];
build up filters
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;
retrieve entries and call EntryProc
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] ~ {
Estimates the cost of enumerating an index of the given type from start to end. The cost model is quite simple: it assumes that the probability of any given character being the nth character of a string is 0.01 for n in [1..N]. The estimate returned is the estimated fraction of the index that must be traversed. For instance, start="a" and end="b" for itype=$lex yields est=0.01, while start="aaa" and end="aac" for itype=$lex yields est=0.000002.
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] ~ {
This routine exists solely for performance reasons. The intent is to identify a range [start..end] of entries in an index that includes all possible values that match the given pattern; clearly this range depends on the ordering of entries in the index ($lex, $ascii, $gmt, etc.). It is always acceptable to return [NIL, NIL], which indicates that the whole index must be enumerated; returning a range that is too small or incorrect, on the other hand, leads to incomplete answers to a filtered query.
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] => {
find greatest common prefix for start and end
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"] ~ {
Trys to deduce an appropriate filter type from the given pattern.
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"];
};
};
LoganQuery filters
The following FilterProcs use very simple caching to avoid having to parse the pattern on every call. We keep a copy of the result of the last parse and do fast pointer comparisons to see if the pattern is the same as before. This single-entry caching scheme does not help if several attribute patterns are using subrange filters at the same time. This should eventually be replaced by caches with several entries.
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] ~ {
r should be of the form "start-end".
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]
Checks if the value is in the range specified by the pattern. The pattern consists of two prefixes separated by a "-".
start, end: Rope.ROPE;
parse pattern
[start, end] ← ParseSubrange[pattern ! SyntaxError => GOTO BadPattern];
IF Rope.Compare[s1: start, s2: end, case: FALSE] = greater THEN GOTO BadPattern;
check start <= prefix(value) <= end
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]
Checks if the value is in the numerical range specified by the pattern. The pattern should consist of two positive integers separated by a "-". If the value can not be parsed as an integer then match=FALSE is returned; if the pattern is bad then match=FALSE and nothingGreater=TRUE is returned.
start, end: Rope.ROPE;
startInt, endInt, valueInt: INT;
parse pattern
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];
check start <= value <= end
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]
Checks if the value is in the chronological range specified by the pattern. The pattern should consist of two date and times (as can be parsed by Tempus) separated by a "-". If the value can not be parsed as a date and time then match=FALSE is returned; if the pattern is bad then match=FALSE and nothingGreater=TRUE is returned.
start, end: Rope.ROPE;
startDate, endDate, valueDate: BasicTime.GMT;
parse pattern
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;
check start <= value <= end
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]
Checks if the value matches the pattern within the time precision of the pattern. The pattern, as well as the value, should be a date and time (as can be parsed by Tempus). If the value can not be parsed as a date and time then match=FALSE is returned; if the pattern is bad then match=FALSE and nothingGreater=TRUE is returned. A match can not occur unless the pattern is no more precise than the value. For example, a pattern of "Wednesday" will match a value of "Wednesday at 2 pm", but not vice versa.
patternDate, valueDate: BasicTime.GMT;
patternPrecision: Tempus.Precision;
parse pattern
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;
check value = pattern
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];
};
Default browser operations
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, "STOP!", StopProc];
AppendMenu[menu, "Browse", BrowseProc];
AppendMenu[menu, "Update", UpdateProc];
AppendMenu[menu, "Delete", DeleteProc, 0, TRUE];
AppendMenu[menu, "UnDelete", UnDeleteProc, 0, TRUE];
AppendMenu[menu, "History", HistoryProc];
AppendMenu[menu, "Details", DetailsProc];
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}];
If an OpProc is registered, then it is called before and after performing the desired operation. The before procedure can return FALSE to indicate that the operation should not be done.
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]]];
};
Initialization
browserIcon ← Icons.NewIconFromFile[file: "LoganBerry.icons", n: 0 ! ANY => CONTINUE];
END.
Doug Terry, November 27, 1985 3:22:06 pm PST
taken from WPBrowserToolImpl.mesa
changes to: DIRECTORY, LoganBerryBrowserTool, browserIcon, db, dbFileName, NamedFilter, Commander, END, BrowseProc, DetailsProc, HistoryProc, MakeMainMenu, BrowserToolRec, MakeBrowserTool, itemHeight, interItemHeight, ruleHeight, patternButtonWidth, patternHSpace, historyHeight, AppendMenu (local of MakeMainMenu), MakeEntryForm, AppendEntry (local of MakeEntryForm), MakeSortButton, DividingLine, FormFieldRec, AddToSortList (local of MakeSortButton), StopProc, BrowseProc, DoQuery, PutEntry (local of DoQuery), NewFilter (local of DoQuery), ROPE, STREAM
Doug Terry, November 27, 1985 4:05:43 pm PST
changes to: PutEntry (local of DoQuery), MakeSortButton, DIRECTORY
Doug Terry, November 27, 1985 5:56:01 pm PST
changes to: MakeSortButton, AddToSortList (local of MakeSortButton), DIRECTORY, DestroyProc, MakeMainMenu, MakeBrowserTool, browserIcon, Commander, LoganBerryBrowserTool
Doug Terry, November 27, 1985 6:18:58 pm PST
changes to: MakeBrowserTool
Doug Terry, January 23, 1986 8:41:38 pm PST
changes to: DestroyProc, MakeBrowserTool
Doug Terry, January 31, 1986 2:46:52 pm PST
changes to: AdminOpsProc, OpenProc, CloseProc, BuildIndiciesProc, CompactLogsProc, DestroyProc, MakeMainMenu, DIRECTORY, AppendMenu (local of MakeMainMenu), MakeBrowserTool, LoganBerryBrowserTool
Doug Terry, January 31, 1986 2:53:26 pm PST
changes to: AdminOpsProc, MakeMainMenu, MakeBrowserTool, AppendMenu (local of MakeMainMenu)
Doug Terry, January 31, 1986 5:21:25 pm PST
changes to: AppendMenu (local of MakeMainMenu), MakeMainMenu, MakeBrowserTool, BrowseProc, DIRECTORY
Doug Terry, March 5, 1986 6:18:08 pm PST
Now calls LoganBerry.Describe to obtain the list of available indices and catches LoganBerry.Errors.
changes to: DIRECTORY, MakeEntryForm, OpenProc, CloseProc, BuildIndiciesProc, CompactLogsProc, DestroyProc, MakeBrowserTool, PutEntry (local of DoQuery)
Doug Terry, April 24, 1986 9:47:20 am PST
Changed to use LoganBerryStub.
changes to: DIRECTORY, LoganBerryBrowserTool, BrowserToolRec, OpenProc, MakeBrowserTool, DoQuery, ReportLBError
Doug Terry, April 24, 1986 9:51:16 am PST
changes to: DIRECTORY, LoganBerryBrowserTool, BrowserToolRec, OpenProc, MakeBrowserTool, DoQuery, ReportLBError
Doug Terry, July 1, 1986 6:00:40 pm PDT
Added History facility.
changes to: FormFieldRec, FormValue, FormValueRec, FormContents, MakeSortButton, ReadEntryForm, NextField (local of ReadEntryForm), AddToHistory, AddToLine (local of AddToHistory), RestoreFromHistory, HistoryButtonProc, DoQuery, BrowseProc, RestoreEntryForm, PutEntry, GetAttributeValue, DIRECTORY, LoganBerryBrowserTool, ROPE, STREAM, HistoryData, HistoryDataRec, RestoreField (local of RestoreEntryForm), HistoryProc, DetailsProc, UnHideViewer, HideViewer, MakeBrowserTool
Doug Terry, July 1, 1986 9:04:42 pm PDT
changes to: BuildIndicesProc, MakeMainMenu
Doug Terry, October 16, 1986 5:58:19 pm PDT
changes to: DoQuery
Doug Terry, October 22, 1986 4:10:21 pm PDT
Changed to use LoganBerryCommands and provide a similar model of operation; added support for updates and deletes.
changes to: BrowserToolRec, UpdateProc, DeleteProc, DetailsProc, MakeMainMenu, MakeInputArea, MakeSortButton, MakeBrowserTool, FormContents, BrowseProc, AddToHistory, HistoryButtonProc, NextField (local of ReadEntryForm), RestoreField (local of RestoreEntryForm), RestoreEntryForm, DoQuery, AttributePattern, AttributePatternRec, HistoryDataRec, MakeEntryForm, ReadEntryForm, DoQuery, DIRECTORY, LoganBerryBrowserTool, PutEntry (local of DoOp), DeleteEntry (local of DoOp)
Doug Terry, October 31, 1986 4:56:08 pm PST
Exports and uses CreateTool operation.
changes to: DIRECTORY, LoganBerryBrowserImpl, BrowserToolRec, AttributePattern, AttributePatternRec, AttributePatterns, MakeEntryForm, AddToHistory, CreateTool, DoOp, PutEntry (local of DoOp), MakeBrowserTool, browserIcon
Doug Terry, November 2, 1986 7:00:17 pm PST
Added support for subrange filtering and UnDelete.
changes to: BrowserToolRec, UnDeleteProc, DetailsProc, MakeEntryForm, DeleteEntry (local of DoOp), DoOp
Doug Terry, November 23, 1986 9:29:41 pm PST
Moved support for filtered queries to this module; removed any command registrations.
changes to: LoganBerryBrowserImpl, HistoryDataRec, historyHeight, MakeMainMenu, HistoryButtonProc, UnHideViewer, CreateTool, SyntaxError, Read, LoganQuery, FilteredQuery, Subrange, ReportLBError, browserIcon, DIRECTORY, BrowserToolRec, PrintEntry, PutEntry (local of DoOp), DoOp
Doug Terry, November 24, 1986 4:58:48 pm PST
Added new filters: DWIM, NumSubrange, DateSubrange, DateAndTime.
changes to: OptimalStart, NamedFilter, subrangeCache, ParseSubrange, ToDash (local of ParseSubrange), Subrange, NumSubrange, DateSubrange, srCache, nsrCache, dsrCache, DateSubrange, DIRECTORY, LoganBerryBrowserImpl, FilteredQuery, NamedFilter, MakeEntryForm
Doug Terry, December 4, 1986 6:59:04 pm PST
Changed CreateTool to create inner (output) viewers of various flavors.
changes to: DIRECTORY, CreateTool
Doug Terry, December 15, 1986 6:31:17 pm PST
Stop! now calls Process.Abort, which raises ABORTED, which is caught in DoOp.
changes to: OptimalStart, BaseStartEnd, DIRECTORY, LoganBerryBrowserImpl, BrowserToolRec, StopProc, DoOp, PutEntry (local of DoOp), DeleteEntry (local of DoOp)
Doug Terry, December 22, 1986 5:12:02 pm PST
changes to: historyHeight, patternChoices, defaultPattern, MakeEntryForm
Doug Terry, December 23, 1986 4:11:02 pm PST
changes to: ReadEntryForm, NextField (local of ReadEntryForm), SyntaxError, QueryWarning, FilteredQuery, DoOp
Doug Terry, December 29, 1986 3:04:30 pm PST
Added computation of start and end for various types of base indices; uses estimated query cost to select the optimal base index if one is not specified.
changes to: BaseStartEnd, Bump (local of BaseStartEnd), Upper (local of BaseStartEnd), Lower (local of BaseStartEnd), MakeEntryForm, ReadEntryForm, CreateTool, FilteredQuery, GetIndexType, QueryCost
changes to: Bump (local of BaseStartEnd), warningThreshold, QueryWarning, FilteredQuery
Doug Terry, December 29, 1986 4:36:38 pm PST
changes to: warningThreshold, QueryWarning, FilteredQuery, Bump (local of BaseStartEnd), Feedback, RegisterFeedbackArea
Doug Terry, January 27, 1987 5:57:51 pm PST
changes to: DIRECTORY, LoganBerryBrowserImpl, DoOp, BrowserToolRec, UnDeleteProc, MakeEntryForm, MakeSortButton, CreateTool
Doug Terry, January 28, 1987 10:58:00 am PST
Added calls to LoganBerryExtras to get the ordering of indices; reduced assumptions about the flavor of the inner viewer (used to assume it was a typescript in various places); made Delete and UnDelete call the client-provided DisplayProc; added calls to the OpProc for $LBUnDelete and $LBStop.
changes to: MakeEntryForm
changes to: DIRECTORY, LoganBerryBrowserImpl, EntryToPatterns, AppendPatterns, DoOp
changes to: BrowseProc, DeleteProc, UnDeleteProc, UnHideViewer, ResetViewer, ReportLBError
Doug Terry, January 28, 1987 9:26:14 pm PST
changes to: BrowseProc, UpdateProc, DeleteProc, UnDeleteProc, OpenProc, CloseProc, BuildIndicesProc, CompactLogsProc, DestroyProc, UnHideViewer, ResetViewer, DoOp, DeleteEntry (local of DoOp), UnDeleteEntry (local of DoOp), ReportLBError
Doug Terry, January 29, 1987 1:47:06 pm PST
changes to: BrowserToolRec, MakeSortButton, DIRECTORY, LoganBerryBrowserImpl, FilteredQuery, DeleteEntry (local of DoOp), DoOp, ClearFeedback, ReportFeedback, ReportLBError
Doug Terry, January 29, 1987 3:42:53 pm PST
changes to: patternHSpace, feedbackHSpace, MakeSortButton, DIRECTORY, FormFieldRec, MakeEntryForm, NextField (local of ReadEntryForm), ReadEntryForm, RestoreField (local of RestoreEntryForm), RestoreEntryForm, DeleteEntry (local of DoOp), ReportFeedback (local of DoOp), DoOp, FilteredQuery, AnalyzePattern
Doug Terry, February 24, 1987 2:04:02 pm PST
Changed the way browsers are customized; clients are now responsible for providing the main menu and operations (see "Default browser operations")
changes to: BrowserTool, DetailsProc, CreateTool, SetDefaults, StandardMainMenu, BrowseProc, DoOp, MakeEntryForm, StandardMainMenu, ReadEntryForm, RestoreEntryForm, ReportFeedback, AddToHistory, PrintEntry, PutEntry (local of DoOp), DeleteEntry (local of DoOp), Feedback (local of DoOp), DataRec, SetDefaults, ReportLBError, DIRECTORY
Doug Terry, February 24, 1987 2:30:23 pm PST
changes to: StandardMainMenu, CreateTool, SetDefaults, DIRECTORY
Doug Terry, March 4, 1987 10:48:08 am PST
changes to: defaultPattern