LoganBerryBrowserTool.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Terry, April 24, 1986 9:51:15 am PST
A tool for interactively browsing LoganBerry databases.
DIRECTORY
Atom USING [GetPName, MakeAtom],
ChoiceButtons USING [EnumTypeRef, BuildEnumTypeSelection, BuildTextPrompt, GetSelectedButton],
Commander USING [CommandProc, Handle, Register],
CommandTool USING [NextArgument],
Containers USING [ ChildXBound, ChildYBound, Container, Create ],
FS USING [ComponentPositions, ExpandName, Position],
Icons USING [ IconFlavor, NewIconFromFile ],
LoganBerryStub USING [AttributeType, AttributeValue, BuildIndices, Close, CompactLogs, Describe, Entry, EntryProc, Error, ErrorCode, Open, OpenDB, SchemaInfo],
LoganQuery USING [ComplexCursor, EndGenerate, FilterEntries, FilterProc, GenerateEntries, NextEntry, Equal, Prefix, Wildcard, RE, Soundex],
Menus USING [AppendMenuEntry, ChangeNumberOfLines, ClickProc, CreateEntry, CreateMenu, GetNumberOfLines, Menu, MenuLine],
MessageWindow USING [Append, Blink],
RefTab USING [Ref, EachPairAction, Fetch, Pairs, Create, Store],
Rope USING [Cat, Concat, Equal, Fetch, FromChar, Index, Length, ROPE, SkipTo, Substr],
Rules USING [ Create, Rule ],
TiogaButtons USING [CreateViewer],
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]
;
LoganBerryBrowserTool:
CEDAR PROGRAM
IMPORTS Atom, ChoiceButtons, Commander, CommandTool, Containers, FS, Icons, LoganBerry: LoganBerryStub, LoganQuery, Menus, MessageWindow, RefTab, Rope, Rules, TiogaButtons, TypeScript, ViewerBLT, ViewerEvents, ViewerOps, ViewerTools
= BEGIN
Types
ROPE: TYPE = Rope.ROPE;
Viewer: TYPE = ViewerClasses.Viewer;
BrowserTool: TYPE = REF BrowserToolRec;
BrowserToolRec:
TYPE =
RECORD[
outer: Containers.Container, -- main container
menu: Menus.Menu, -- command menu
dbFileName: ROPE, -- name of database
db: LoganBerry.OpenDB, -- open database handle
entryform: RefTab.Ref, -- set of "FormField"s
sortButton: ChoiceButtons.EnumTypeRef, -- order of retrieval
details: Containers.Container, -- container for choice buttons
historyData: REF ANY, -- log of executed queries
history: Viewer, -- viewer for history data
inner: Viewer, -- viewer for retrieved database entries
stop: BOOLEAN, -- stop database retrievals if TRUE
height: CARDINAL ← 0 -- current height of tool (excluding typescript viewer)
];
FormField: TYPE = REF FormFieldRec;
FormFieldRec:
TYPE =
RECORD [
textViewer: Viewer,
patternButton: ChoiceButtons.EnumTypeRef
];
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];
DoQuery[tool.db, tool.entryform, Atom.MakeAtom[ChoiceButtons.GetSelectedButton[tool.sortButton]], tool.inner, tool];
ViewerOps.PaintViewer[viewer: tool.inner, hint: all];
};
DetailsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF tool.details.wx = 0
THEN
HideViewer[tool.details]
ELSE
UnHideViewer[tool.details];
};
HistoryProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
IF tool.history.wx = 0
THEN {
HideViewer[tool.history];
ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy - historyHeight, w: tool.inner.ww, h: tool.inner.wh];
tool.height ← tool.height - historyHeight;
}
ELSE {
ViewerOps.MoveViewer[viewer: tool.inner, x: tool.inner.wx, y: tool.inner.wy + historyHeight, w: tool.inner.ww, h: tool.inner.wh];
UnHideViewer[tool.history];
tool.height ← tool.height + historyHeight;
};
MessageWindow.Append["Not fully implemented.", TRUE];
MessageWindow.Blink[];
};
AdminOpsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
newCount: CARDINAL ← IF Menus.GetNumberOfLines[tool.menu] = 1 THEN 2 ELSE 1;
Menus.ChangeNumberOfLines[tool.menu, newCount];
ViewerBLT.ChangeNumberOfLines[tool.outer, newCount];
};
OpenProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
msg: ROPE ← NIL;
tool: BrowserTool ← NARROW[clientData];
tool.db ← LoganBerry.Open[dbName: tool.dbFileName ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
CloseProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.Close[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
BuildIndiciesProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.BuildIndices[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
CompactLogsProc: Menus.ClickProc = {
[parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE]
tool: BrowserTool ← NARROW[clientData];
LoganBerry.CompactLogs[db: tool.db ! LoganBerry.Error => {ReportLBError[ec, explanation, tool.inner]; CONTINUE}];
};
DestroyProc: ViewerEvents.EventProc = {
[viewer: ViewerClasses.Viewer, event: ViewerEvents.ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
-- Does nothing at the moment
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, "Details", DetailsProc];
AppendMenu[tool.menu, "History", HistoryProc];
AppendMenu[tool.menu, "AdminOps", AdminOpsProc];
second line
AppendMenu[tool.menu, "Open", OpenProc, 1];
AppendMenu[tool.menu, "Close", CloseProc, 1, TRUE];
AppendMenu[tool.menu, "BuildIndicies", BuildIndiciesProc, 1, TRUE];
AppendMenu[tool.menu, "CompactLogs", CompactLogsProc, 1, TRUE];
};
Entry form
MakeEntryForm:
PROC [tool: BrowserTool]
RETURNS [] ~ {
dbSchema: LoganBerry.SchemaInfo ← LoganBerry.Describe[db: tool.db];
tool.entryform ← RefTab.Create[];
FOR k:
LIST
OF LoganBerry.AttributeType ← dbSchema.keys, k.rest
WHILE k #
NIL
DO
field: FormField ← NEW[FormFieldRec];
field.patternButton ← ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, buttonNames: LIST["exact", "prefix", "wildcard", "reg. exp.", "soundex"], default: "prefix", style: flipThru, maxWidth: patternButtonWidth];
field.textViewer ← ChoiceButtons.BuildTextPrompt[viewer: tool.outer, x: field.patternButton.nextx, y: tool.height, title: Rope.Concat[Atom.GetPName[k.first], ":"]].textViewer;
tool.height ← tool.height + itemHeight + interItemHeight;
[] ← RefTab.Store[tool.entryform, k.first, field];
ENDLOOP;
};
MakeSortButton:
PROC [tool: BrowserTool]
RETURNS [] ~ {
AddToSortList: RefTab.EachPairAction = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
choiceList ← CONS[Atom.GetPName[NARROW[key]], choiceList];
RETURN[quit: FALSE];
};
choiceList: LIST OF ROPE ← NIL;
[] ← RefTab.Pairs[x: tool.entryform, action: AddToSortList];
tool.height ← tool.height + interItemHeight;
tool.sortButton ← ChoiceButtons.BuildEnumTypeSelection[viewer: tool.details, x: patternHSpace, y: tool.height, title: "Order by:", buttonNames: choiceList, default: NIL, style: menuSelection --vs. flipThru--];
tool.height ← tool.height + itemHeight + interItemHeight;
};
Commander commands
MakeBrowserTool: Commander.CommandProc = {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
tool: BrowserTool ← NEW[BrowserToolRec];
shortname: ROPE;
cp: FS.ComponentPositions;
errormsg: ROPE ← NIL;
tool.dbFileName ← CommandTool.NextArgument[cmd];
IF tool.dbFileName =
NIL
THEN
RETURN[msg: "No database name given.\n"];
[tool.dbFileName, cp] ← FS.ExpandName[tool.dbFileName];
open database
tool.db ← LoganBerry.Open[dbName: tool.dbFileName ! LoganBerry.Error => {errormsg ← Rope.Cat["Error: ", Atom.GetPName[ec], " — ", explanation]; CONTINUE}];
IF errormsg #
NIL
THEN
RETURN[msg: errormsg];
find short database name
shortname ← Rope.Substr[base: tool.dbFileName, start: cp.base.start, len: cp.base.length];
create command section
MakeMainMenu[tool];
tool.outer ← Containers.Create[info: [
name: Rope.Concat["LoganBerry Browser: ", tool.dbFileName],
icon: browserIcon,
label: shortname,
iconic: FALSE,
column: left,
menu: tool.menu,
scrollable: FALSE]];
Menus.ChangeNumberOfLines[tool.menu, 1];
ViewerBLT.ChangeNumberOfLines[tool.outer, 1];
ViewerOps.AddProp[viewer: tool.outer, prop: $BrowserTool, val: tool];
[] ← ViewerEvents.RegisterEventProc[proc: DestroyProc, event: destroy, filter: tool.outer];
create input form
tool.details ← Containers.Create[info: [
parent: tool.outer,
ww: 9999,
wh: 9999,
scrollable: FALSE,
border: FALSE]];
Containers.ChildXBound[container: tool.outer, child: tool.details];
Containers.ChildYBound[container: tool.outer, child: tool.details];
tool.height ← interItemHeight;
MakeEntryForm[tool];
MakeSortButton[tool];
DividingLine[tool];
create history viewer
tool.history ← TiogaButtons.CreateViewer[info: [
parent: tool.outer,
wy: tool.height,
ww: 9999,
wh: historyHeight,
border: TRUE]];
Containers.ChildXBound[tool.outer, tool.history]; -- constrain rule to be width of parent
HideViewer[tool.history];
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
};
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];
};
Database retrieval
DoQuery:
PROC [db: LoganBerry.OpenDB, form: RefTab.Ref, sortby: LoganBerry.AttributeType, v: Viewer, tool: BrowserTool]
RETURNS [] ~ {
ENABLE {
LoganBerry.Error => {ReportLBError[ec, explanation, v]; CONTINUE};
};
PutEntry: LoganBerry.EntryProc ~ {
PROC [entry: Entry] RETURNS [continue: BOOL]
FOR e: LoganBerry.Entry ← entry, e.rest
UNTIL e =
NIL
DO
TypeScript.ChangeLooks[v, 'b]; -- print atribute type in bold
TypeScript.PutRope[v, Atom.GetPName[e.first.type]];
TypeScript.ChangeLooks[v, ' ]; -- restore normal looks
TypeScript.PutRope[v, ": "];
TypeScript.PutRope[v, e.first.value];
TypeScript.PutChar[v, '\n];
ENDLOOP;
TypeScript.PutChar[v, '\n];
RETURN[TRUE];
};
NewFilter: RefTab.EachPairAction = {
[key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOLEAN]
field: FormField = NARROW[val];
contents: ROPE ← ViewerTools.GetContents[field.textViewer];
ptype: ROPE ← ChoiceButtons.GetSelectedButton[field.patternButton];
IF
NOT Rope.Equal[contents, ""]
AND
NARROW[key,
ATOM] # sortby
THEN
cursor ← LoganQuery.FilterEntries[input: cursor, pattern: contents, filter: NamedFilter[ptype], atype: NARROW[key]];
RETURN[quit: FALSE];
};
start, end: ROPE ← NIL;
field: FormField;
pattern, ptype: ROPE;
cursor: LoganQuery.ComplexCursor;
entry: LoganBerry.Entry;
figure out where to start in database to save work
field ← NARROW[RefTab.Fetch[form, sortby].val];
pattern ← ViewerTools.GetContents[field.textViewer];
ptype ← ChoiceButtons.GetSelectedButton[field.patternButton];
start ← OptimalStart[pattern, ptype];
simple base query
cursor ← LoganQuery.GenerateEntries[db: db, key: sortby, start: start, end: end];
build up filters
IF
NOT Rope.Equal[pattern, ""]
THEN
cursor ← LoganQuery.FilterEntries[input: cursor, pattern: pattern, filter: NamedFilter[ptype], atype: sortby, stopIfNothingGreater: TRUE];
[] ← RefTab.Pairs[form, NewFilter];
retrieve entries and build directory browser
tool.stop ← FALSE;
entry ← LoganQuery.NextEntry[cursor];
WHILE entry #
NIL
AND
NOT tool.stop
DO
[] ← PutEntry[entry];
entry ← LoganQuery.NextEntry[cursor];
ENDLOOP;
LoganQuery.EndGenerate[cursor];
};
GetAttributeValue:
PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType]
RETURNS [LoganBerry.AttributeValue] ~ {
FOR e: LoganBerry.Entry ← entry, e.rest
WHILE e #
NIL
DO
IF e.first.type = type
THEN
RETURN[e.first.value];
ENDLOOP;
RETURN[NIL];
};
OptimalStart:
PROC [pattern:
ROPE, ptype:
ROPE]
RETURNS [start:
ROPE] ~ {
SELECT
TRUE
FROM
Rope.Equal[ptype, "exact"] => {
start ← pattern;
};
Rope.Equal[ptype, "prefix"] => {
start ← pattern;
};
Rope.Equal[ptype, "wildcard"] => {
start ← Rope.Substr[base: pattern, len: Rope.Index[s1: pattern, s2: "*"]];
};
Rope.Equal[ptype, "reg. exp."] => {
i: INT ← Rope.SkipTo[s: pattern, skip: "\'#[^$*+(\\<{!"]; -- look for special chars
IF
NOT i = Rope.Length[pattern]
AND Rope.Fetch[pattern, i] = '*
THEN
-- could be zero of previous char
i ← i-1;
start ← Rope.Substr[base: pattern, len: i];
};
Rope.Equal[ptype, "soundex"] => {
start ← Rope.FromChar[Rope.Fetch[base: pattern, index: 0]];
};
ENDCASE => start ← NIL;
};
NamedFilter:
PROC [ptype:
ROPE]
RETURNS [LoganQuery.FilterProc] ~ {
RETURN[
SELECT
TRUE
FROM
Rope.Equal[ptype, "exact"] => LoganQuery.Equal,
Rope.Equal[ptype, "prefix"] => LoganQuery.Prefix,
Rope.Equal[ptype, "wildcard"] => LoganQuery.Wildcard,
Rope.Equal[ptype, "reg. exp."] => LoganQuery.RE,
Rope.Equal[ptype, "soundex"] => LoganQuery.Soundex,
ENDCASE => LoganQuery.Equal];
};
ReportLBError:
PROC [ec: LoganBerry.ErrorCode, explanation:
ROPE, v: Viewer]
RETURNS [] ~ {
TypeScript.Reset[v];
TypeScript.PutRope[v, Rope.Cat["Error: ", Atom.GetPName[ec], " — ", explanation]];
};
Registration, Initialization
browserIcon ← Icons.NewIconFromFile[file: "LoganBerry.icons", n: 0 ! ANY => CONTINUE];
Commander.Register[key: "LoganBerryBrowser", proc: MakeBrowserTool,
doc: "Create a LoganBerry browser." ];
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