LoganBerryBrowserImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Terry, November 23, 1986 9:29:41 pm PST
A tool for interactively browsing LoganBerry databases.
DIRECTORY
Atom USING [GetPName, MakeAtom],
ChoiceButtons USING [EnumTypeRef, BuildEnumTypeSelection, BuildTextPrompt, GetSelectedButton, UpdateChoiceButtons],
Containers USING [ ChildXBound, ChildYBound, Container, Create ],
FS USING [ComponentPositions, ExpandName, Position],
GList USING [Append],
Icons USING [ IconFlavor, NewIconFromFile ],
IO USING [atom, BreakProc, EndOfStream, GetTokenRope, GetLineRope, TokenProc, GetChar, SkipWhitespace, PeekChar, GetRopeLiteral, Error, IDProc, STREAM, PutRope, PutFR, PutF, RIS, RopeFromROS, rope, ROS],
LoganBerryStub USING [AttributeType, AttributeValue, BuildIndices, Close, CompactLogs, DeleteEntry, Describe, Entry, EntryProc, Error, ErrorCode, Open, OpenDB, SchemaInfo, WriteEntry],
LoganQuery USING [ComplexCursor, EndGenerate, Equal, FilterEntries, FilterProc, GenerateEntries, Prefix, NextEntry, RE, Soundex, Wildcard],
Menus USING [AppendMenuEntry, ChangeNumberOfLines, ClickProc, CreateEntry, CreateMenu, GetNumberOfLines, Menu, MenuLine],
RefTab USING [Ref, EachPairAction, Fetch, Pairs, Create, Store],
Rope USING [Cat, Compare, Concat, Equal, Fetch, FromChar, Index, Length, ROPE, SkipTo, Substr],
Rules USING [ Create, Rule ],
TiogaButtons USING [CreateButton, CreateViewer, TiogaButtonProc],
TypeScript USING [ Create, ChangeLooks, Reset, PutChar, PutRope ],
ViewerBLT USING [ChangeNumberOfLines],
ViewerClasses USING [ Viewer, ViewerClassRec, ViewerRec ],
ViewerEvents USING [ EventProc, RegisterEventProc ],
ViewerOps USING [AddProp, MoveViewer, PaintViewer],
ViewerTools USING [GetContents, SetContents],
LoganBerryBrowser;
LoganBerryBrowserImpl:
CEDAR PROGRAM
IMPORTS Atom, ChoiceButtons, Containers, FS, GList, Icons, IO, LoganBerry: LoganBerryStub, LoganQuery, Menus, RefTab, Rope, Rules, TiogaButtons, TypeScript, ViewerBLT, ViewerEvents, ViewerOps, ViewerTools
EXPORTS LoganBerryBrowser
= BEGIN
Types
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
BrowserTool: TYPE = REF BrowserToolRec;
BrowserToolRec:
TYPE =
RECORD[
outer: Containers.Container, -- main container
menu: Menus.Menu, -- command menu
db: LoganBerry.OpenDB, -- open database handle
dbInfo: LoganBerry.SchemaInfo, -- database schema
entryform: RefTab.Ref, -- set of "FormField"s
inputArea: Viewer, -- area for type in
sortButton: ChoiceButtons.EnumTypeRef, -- order of retrieval
details: Containers.Container, -- container for choice buttons
historyData: REF ANY, -- log of executed queries
history: Viewer, -- viewer for history data
inner: Viewer, -- viewer for retrieved database entries
clientProc: LoganBerryBrowser.DisplayProc ← PrintEntry, -- called for each retrieved entry
opProc: LoganBerryBrowser.OpProc ← NIL, -- called for each operation (twice)
clientData: REF ← NIL, -- passed to clientProc
lastDeletes: LIST OF LoganBerry.Entry ← NIL, -- entries recently deleted
stop: BOOLEAN ← FALSE, -- stop database retrievals if TRUE
height: CARDINAL ← 0 -- current height of tool (excluding typescript viewer)
];
FormField: TYPE = REF FormFieldRec;
FormFieldRec:
TYPE =
RECORD [
textViewer: Viewer,
patternButton: ChoiceButtons.EnumTypeRef
];
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;
historyHeight: CARDINAL = 100;
Command menu
StopProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
tool.stop ← TRUE;
};
BrowseProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF mouseButton # blue
THEN
TypeScript.Reset[tool.inner];
DoOp[$LBQuery, tool];
};
UpdateProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
DoOp[$LBWrite, tool];
};
DeleteProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF mouseButton # blue
THEN
TypeScript.Reset[tool.inner];
DoOp[$LBDelete, tool];
};
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
TypeScript.Reset[tool.inner];
FOR l:
LIST
OF LoganBerry.Entry ← tool.lastDeletes, l.rest
WHILE l#
NIL
DO
LoganBerry.WriteEntry[db: tool.db, entry: l.first ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE};];
TypeScript.PutRope[tool.inner, IO.PutFR["UnDeleted %g: %g\n", IO.atom[tool.dbInfo.keys.first], IO.rope[GetAttributeValue[l.first, tool.dbInfo.keys.first]]]];
ENDLOOP;
tool.lastDeletes ← NIL; -- can't undo an undelete
};
DetailsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF tool.details.wx = 0
THEN
HideViewer[tool.details]
ELSE
UnHideViewer[tool.details];
};
HistoryProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF tool.history.wx = 0
THEN {
HideViewer[tool.history];
ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy - historyHeight, w: tool.inner.ww, h: tool.inner.wh];
tool.height ← tool.height - historyHeight;
}
ELSE {
ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy + historyHeight, w: tool.inner.ww, h: tool.inner.wh];
UnHideViewer[tool.history];
tool.height ← tool.height + historyHeight;
};
};
AdminOpsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
newCount: CARDINAL ← IF Menus.GetNumberOfLines[tool.menu] = 1 THEN 2 ELSE 1;
Menus.ChangeNumberOfLines[tool.menu, newCount];
ViewerBLT.ChangeNumberOfLines[tool.outer, newCount];
};
OpenProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
msg: ROPE ← NIL;
tool: BrowserTool ← NARROW[clientData];
tool.db ← LoganBerry.Open[dbName: tool.dbInfo.dbName ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
CloseProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.Close[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
BuildIndicesProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.BuildIndices[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
CompactLogsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.CompactLogs[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
DestroyProc: ViewerEvents.EventProc = {
[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
-- Does nothing at the moment
tool: BrowserTool ← NARROW[ViewerOps.FetchProp[viewer: viewer, prop: $BrowserTool]];
LoganBerry.Close[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
MakeMainMenu:
PROC [tool: BrowserTool]
RETURNS [] ~ {
AppendMenu:
PROC[menu: Menus.Menu, name:
ROPE, proc: Menus.ClickProc, line: Menus.MenuLine ← 0, guarded:
BOOL ←
FALSE] = {
Menus.AppendMenuEntry[
menu: menu,
entry: Menus.CreateEntry[name: name, proc: proc, clientData: tool, guarded: guarded],
line: line
];
};
tool.menu ← Menus.CreateMenu[lines: 2];
first line
AppendMenu[tool.menu, "STOP!", StopProc];
AppendMenu[tool.menu, "Browse", BrowseProc];
AppendMenu[tool.menu, "Update", UpdateProc];
AppendMenu[tool.menu, "Delete", DeleteProc, 0, TRUE];
AppendMenu[tool.menu, "UnDelete", UnDeleteProc, 0, TRUE];
AppendMenu[tool.menu, "History", HistoryProc];
AppendMenu[tool.menu, "Details", DetailsProc];
AppendMenu[tool.menu, "AdminOps", AdminOpsProc];
second line
AppendMenu[tool.menu, "Open", OpenProc, 1];
AppendMenu[tool.menu, "Close", CloseProc, 1, TRUE];
AppendMenu[tool.menu, "BuildIndices", BuildIndicesProc, 1, TRUE];
AppendMenu[tool.menu, "CompactLogs", CompactLogsProc, 1, TRUE];
};
Entry form
MakeEntryForm:
PROC [tool: BrowserTool]
RETURNS [] ~ {
tool.entryform ← RefTab.Create[];
FOR k:
LIST
OF LoganBerry.AttributeType ← tool.dbInfo.keys, k.rest
WHILE k #
NIL
DO
field: FormField ← NEW[FormFieldRec];
field.patternButton ← ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, buttonNames: LIST["exact", "prefix", "wildcard", "reg. exp.", "soundex", "subrange"], default: "prefix", style: flipThru, maxWidth: patternButtonWidth];
field.textViewer ← ChoiceButtons.BuildTextPrompt[viewer: tool.outer, x: field.patternButton.nextx, y: tool.height, title: Rope.Concat[Atom.GetPName[k.first], ":"]].textViewer;
tool.height ← tool.height + itemHeight + interItemHeight;
[] ← RefTab.Store[tool.entryform, k.first, field];
ENDLOOP;
tool.inputArea ← ChoiceButtons.BuildTextPrompt[viewer: tool.outer, x: patternHSpace, y: tool.height, title: "other attributes:"].textViewer;
tool.height ← tool.height + itemHeight + interItemHeight;
};
MakeSortButton:
PROC [tool: BrowserTool]
RETURNS [] ~ {
AddToSortList: RefTab.EachPairAction = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
choiceList ← CONS[Atom.GetPName[NARROW[key]], choiceList];
RETURN[quit: FALSE];
};
choiceList: LIST OF ROPE ← NIL;
[] ← RefTab.Pairs[x: tool.entryform, action: AddToSortList];
tool.height ← tool.height + interItemHeight;
tool.sortButton ← ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, title: "Order by:", buttonNames: choiceList, default: NIL, style: menuSelection --vs. flipThru--];
tool.height ← tool.height + itemHeight + interItemHeight;
};
ReadEntryForm:
PROC [tool: BrowserTool]
RETURNS [form: LoganBerryBrowser.AttributePatterns, other:
ROPE] ~ {
First field in returned data is the "order by" field.
NextField: RefTab.EachPairAction = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
text: ROPE;
label: ATOM = NARROW[key];
field: FormField = NARROW[val];
text ← ViewerTools.GetContents[field.textViewer];
IF label # form.first.attr.type
AND
NOT Rope.Equal[text, ""]
THEN {
fv: LoganBerryBrowser.AttributePattern ← NEW[LoganBerryBrowser.AttributePatternRec];
fv.attr.type ← label;
fv.attr.value ← text;
fv.ptype ← ChoiceButtons.GetSelectedButton[field.patternButton];
end.rest ← LIST[fv];
end ← end.rest;
};
RETURN[quit: FALSE];
};
sort: LoganBerryBrowser.AttributePattern ← NEW[LoganBerryBrowser.AttributePatternRec];
end: LoganBerryBrowser.AttributePatterns;
field: FormField;
sort.attr.type ← Atom.MakeAtom[ChoiceButtons.GetSelectedButton[tool.sortButton]];
field ← NARROW[RefTab.Fetch[tool.entryform, sort.attr.type].val];
sort.attr.value ← ViewerTools.GetContents[field.textViewer];
sort.ptype ← ChoiceButtons.GetSelectedButton[field.patternButton];
form ← end ← LIST[sort];
[] ← RefTab.Pairs[tool.entryform, NextField];
other ← ViewerTools.GetContents[tool.inputArea];
};
RestoreEntryForm:
PROC [tool: BrowserTool, form: 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];
};
RETURN[quit: FALSE];
};
ChoiceButtons.UpdateChoiceButtons[tool.details, tool.sortButton, Atom.GetPName[form.first.attr.type]];
[] ← RefTab.Pairs[tool.entryform, RestoreField];
ViewerTools.SetContents[tool.inputArea, other, FALSE];
ViewerOps.PaintViewer[viewer: tool.outer, hint: all];
};
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, cmd:
ROPE, form: LoganBerryBrowser.AttributePatterns, other:
ROPE]
RETURNS [] ~ {
data: HistoryData = NEW[HistoryDataRec ← [tool, cmd, form, other]];
line: STREAM ← IO.ROS[];
IO.PutRope[line, cmd];
IO.PutRope[line, " "];
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];
};
Create main tool
CreateTool:
PUBLIC PROC [db: LoganBerry.OpenDB, proc: LoganBerryBrowser.DisplayProc ←
NIL, oproc: LoganBerryBrowser.OpProc ←
NIL, clientData:
REF ←
NIL] = {
tool: BrowserTool;
shortname: ROPE;
cp: FS.ComponentPositions;
initialize tool
tool ← NEW[BrowserToolRec];
tool.db ← db;
tool.dbInfo ← LoganBerry.Describe[db: tool.db];
tool.clientProc ← proc;
tool.opProc ← oproc;
tool.clientData ← clientData;
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
MakeMainMenu[tool];
tool.outer ← Containers.Create[info: [
name: Rope.Concat["LoganBerry Browser: ", tool.dbInfo.dbName],
icon: browserIcon,
label: shortname,
iconic: FALSE,
column: left,
menu: tool.menu,
scrollable: FALSE]];
Menus.ChangeNumberOfLines[tool.menu, 1];
ViewerBLT.ChangeNumberOfLines[tool.outer, 1];
ViewerOps.AddProp[viewer: tool.outer, prop: $BrowserTool, val: tool];
[] ← ViewerEvents.RegisterEventProc[proc: DestroyProc, event: destroy, filter: tool.outer];
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
tool.inner ← TypeScript.Create[info: [
name: "LoganBerry Browser output",
parent: tool.outer,
wx: 0,
wy: tool.height,
ww: 9999,
wh: 9999,
border: FALSE]];
Containers.ChildXBound[tool.outer, tool.inner]; -- constrain rule to be width of parent
Containers.ChildYBound[tool.outer, tool.inner]; -- constrain rule to be height of parent
};
PrintEntry:
PUBLIC LoganBerryBrowser.DisplayProc = {
[entry: LoganBerry.Entry, output: ViewerClasses.Viewer, clientData: REF ← NIL] RETURNS [continue: BOOL]
Write entry in browser's typescript viewer.
FOR e: LoganBerry.Entry ← entry, e.rest
UNTIL e =
NIL
DO
TypeScript.ChangeLooks[output, 'b]; -- print atribute type in bold
TypeScript.PutRope[output, Atom.GetPName[e.first.type]];
TypeScript.ChangeLooks[output, ' ]; -- restore normal looks
TypeScript.PutRope[output, ": "];
TypeScript.PutRope[output, e.first.value];
TypeScript.PutChar[output, '\n];
ENDLOOP;
TypeScript.PutChar[output, '\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;
};
LoganQuery filters
FilteredQuery:
PUBLIC
PROC [db: LoganBerry.OpenDB, patterns: LoganBerryBrowser.AttributePatterns, proc: LoganBerry.EntryProc]
RETURNS [] ~ {
start, end: ROPE ← NIL;
cursor: LoganQuery.ComplexCursor;
entry: LoganBerry.Entry;
IF patterns = NIL THEN RETURN;
figure out where to start in database to save work
start ← OptimalStart[patterns.first.attr.value, patterns.first.ptype];
simple base query
cursor ← LoganQuery.GenerateEntries[db: db, key: patterns.first.attr.type, start: start, end: end];
build up filters
FOR p: LoganBerryBrowser.AttributePatterns ← patterns, p.rest
WHILE p #
NIL
DO
IF
NOT Rope.Equal[p.first.attr.value, ""]
THEN
cursor ← LoganQuery.FilterEntries[input: cursor, pattern: p.first.attr.value, filter: NamedFilter[p.first.ptype], atype: p.first.attr.type, stopIfNothingGreater: p=patterns];
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];
};
OptimalStart:
PROC [pattern:
ROPE, ptype:
ROPE]
RETURNS [start:
ROPE] ~ {
SELECT
TRUE
FROM
Rope.Equal[ptype, "exact",
FALSE], Rope.Equal[ptype, "equal",
FALSE] => {
start ← pattern;
};
Rope.Equal[ptype, "prefix",
FALSE] => {
start ← pattern;
};
Rope.Equal[ptype, "wildcard",
FALSE] => {
start ← Rope.Substr[base: pattern, len: Rope.Index[s1: pattern, s2: "*"]];
};
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];
};
Rope.Equal[ptype, "soundex",
FALSE] => {
start ← Rope.FromChar[Rope.Fetch[base: pattern, index: 0]];
};
Rope.Equal[ptype, "subrange",
FALSE] => {
ENABLE IO.EndOfStream, IO.Error => {start ← pattern; CONTINUE};
s: IO.STREAM ← IO.RIS[pattern];
start ← IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetTokenRope[s, ToDash].token;
};
ENDCASE => start ← pattern;
};
NamedFilter:
PROC [ptype:
ROPE]
RETURNS [LoganQuery.FilterProc] ~ {
RETURN[
SELECT
TRUE
FROM
Rope.Equal[ptype, "exact", FALSE], Rope.Equal[ptype, "equal", FALSE] => LoganQuery.Equal,
Rope.Equal[ptype, "prefix", FALSE] => LoganQuery.Prefix,
Rope.Equal[ptype, "wildcard", FALSE] => LoganQuery.Wildcard,
Rope.Equal[ptype, "reg. exp.", FALSE], Rope.Equal[ptype, "re", FALSE] => LoganQuery.RE,
Rope.Equal[ptype, "soundex", FALSE] => LoganQuery.Soundex,
Rope.Equal[ptype, "subrange", FALSE] => Subrange,
ENDCASE => LoganQuery.Equal];
};
ToDash:
IO.BreakProc = {
[char: CHAR] RETURNS [IO.CharClass]
RETURN[
SELECT char
FROM
'- => sepr,
ENDCASE => other];
};
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 "-".
ENABLE IO.EndOfStream, IO.Error => GOTO BadPattern;
start, end: Rope.ROPE;
s: IO.STREAM;
parse pattern
s ← IO.RIS[pattern];
start ← IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetTokenRope[s, ToDash].token;
IF IO.GetChar[s] # '- THEN GOTO BadPattern;
end ← IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetLineRope[s];
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: FALSE];
};
Primary operations
DoOp:
PROC [cmd:
ATOM, tool: BrowserTool]
RETURNS [] ~ {
ENABLE {
LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE};
};
PutEntry: LoganBerry.EntryProc = {
[entry: LoganBerry.Entry] RETURNS [continue: BOOL]
IF
NOT tool.clientProc[entry, tool.inner, tool.clientData]
THEN
tool.stop ← TRUE;
RETURN[NOT tool.stop];
};
DeleteEntry: LoganBerry.EntryProc = {
[entry: LoganBerry.Entry] RETURNS [continue: BOOL]
value: LoganBerry.AttributeValue ← GetAttributeValue[entry, primaryKey];
LoganBerry.DeleteEntry[db: tool.db, key: primaryKey, value: value];
TypeScript.PutRope[tool.inner, IO.PutFR["Deleted %g: %g\n", IO.atom[primaryKey], IO.rope[value]]];
tool.lastDeletes ← CONS[entry, tool.lastDeletes];
RETURN[NOT tool.stop];
};
other: ROPE;
all, form, otherPatterns: LoganBerryBrowser.AttributePatterns;
primaryKey: LoganBerry.AttributeType;
entry: LoganBerry.Entry;
tool.stop ← FALSE;
[form, other] ← ReadEntryForm[tool];
otherPatterns ← ReadAttributePatterns[IO.RIS[other] ! SyntaxError => {ReportLBError[$MalformedInput, explanation, tool.inner]; CONTINUE}];
all ← NARROW[GList.Append[form, otherPatterns]];
AddToHistory[tool, Atom.GetPName[cmd], form, other];
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.
IF tool.opProc #
NIL
THEN
IF NOT tool.opProc[cmd, FALSE, tool.inner, tool.clientData] THEN RETURN;
SELECT cmd
FROM
$LBQuery => {
FilteredQuery[db: tool.db, patterns: all, proc: PutEntry];
};
$LBWrite => {
entry ← PatternsToEntry[all];
LoganBerry.WriteEntry[db: tool.db, entry: entry];
};
$LBDelete => {
primaryKey ← tool.dbInfo.keys.first;
tool.lastDeletes ← NIL;
FilteredQuery[db: tool.db, patterns: all, proc: DeleteEntry];
};
ENDCASE => NULL;
IF tool.opProc #
NIL
THEN
[] ← tool.opProc[cmd, TRUE, tool.inner, tool.clientData];
};
GetAttributeValue:
PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType]
RETURNS [LoganBerry.AttributeValue] ~ {
FOR e: LoganBerry.Entry ← entry, e.rest
WHILE e #
NIL
DO
IF e.first.type = type
THEN
RETURN[e.first.value];
ENDLOOP;
RETURN[NIL];
};
ReportLBError:
PROC [ec: LoganBerry.ErrorCode, explanation:
ROPE, v: Viewer]
RETURNS [] ~ {
TypeScript.Reset[v];
TypeScript.PutRope[v, Rope.Cat["Error: ", Atom.GetPName[ec], " — ", explanation]];
};
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