[_CDMiwok_01_]<cedarcommon2.0>Gargoyle>GGScriptStatsImpl.mesa!2

GGScriptStatsImpl.mesa

Last edited by Bier on November 8, 1987 11:41:57 pm PST

Contents: Routines for processing one or more SessionLog scripts to determine the frequency of user events. Some of these routines are tailored for Gargoyle scripts in particular. Others are more general.

Pier, December 12, 1988 5:18:03 pm PST

Bier, October 3, 1989 11:59:32 pm PDT

Last tweaked by Mike Spreitzer on May 3, 1990 3:45:42 pm PDT

DIRECTORY

Atom, BasicTime, Commander, CommandTool, Feedback, FeedbackOps, FeedbackTypes, File, FileNames, FS, GGFileOps, GGScriptStats, IO, RefTab, Rope, SessionLog, SystemNames, ViewerClasses;

GGScriptStatsImpl: CEDAR PROGRAM

IMPORTS Atom, BasicTime, Commander, CommandTool, Feedback, FeedbackOps, File, FileNames, FS, GGFileOps, IO, RefTab, Rope, SessionLog, SystemNames

EXPORTS GGScriptStats = BEGIN

Script Formats

Normal Gargoyle Script

Version 8710.19
SetSlopes ...
During ...
AllUp

Script Summary

Comment "[Queenfish]<Cedar>Users>Bier.pa>Gargoyle>bier871019-00-06-13.script!2"
Version 1
SetMidpoints 3
AllUp 19

The atomOrder also includes $SectionHeader atoms, used to add extra spacing to the output.

Totals File

Version 1
SetMidpoints 3
AllUp 19

The atomOrder also includes $SectionHeader atoms, used to add headers and section statistics to the output.

ArgumentType: TYPE = {none, rope, rope2, refInt, refReal, refCard};

AtomListt: TYPE = REF AtomListtObj;

AtomListtObj: TYPE = GGScriptStats.AtomListtObj;

Database: TYPE = REF DatabaseObj;

DatabaseObj: TYPE = GGScriptStats.DatabaseObj;

MsgRouter: TYPE = FeedbackTypes.MsgRouter;

Viewer: TYPE = ViewerClasses.Viewer;

AtomSeq: TYPE = REF AtomSeqObj;

AtomSeqObj: TYPE = RECORD [

seq: SEQUENCE len: NAT OF ATOM

];

CardSeq: TYPE = REF CardSeqObj;

CardSeqObj: TYPE = RECORD [

seq: SEQUENCE len: NAT OF CARD

];

RegisteredEvent: TYPE = REF RegisteredEventObj;

RegisteredEventObj: TYPE = RECORD [

argType: ArgumentType,

count: CARD,

fraction: REAL,

addOn: BOOL ← FALSE, -- this atom was not registered in the original table

system: BOOL ← FALSE,

text: Rope.ROPE ← NIL

];

Problem: SIGNAL [msg: Rope.ROPE] = Feedback.Problem;

ProcessOneScript: PUBLIC PROC [scriptName: Rope.ROPE, resultName: Rope.ROPE, workingDirectory: Rope.ROPE] = {

fullName: Rope.ROPE;

success, versionSpecified, alreadyExists: BOOL ← FALSE;

resultStream: IO.STREAM;

database: Database;

typescript: Viewer;

router: MsgRouter;

printTime: INT;

BEGIN

[alreadyExists, typescript] ← FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];

router ← Feedback.CreateRouter[];

FeedbackOps.SetTypescript[router, $ScriptStats];

[fullName, success, versionSpecified] ← GGFileOps.GetGenericFileName["ScriptStats", resultName, workingDirectory, "statistics", LIST["gargoyle", "ip", "script"], router];

resultStream ← FS.StreamOpen[fullName, $create ! FS.Error => GOTO FSError];

database ← CreateDatabase[];

printTime ← ProcessScript[scriptName, resultStream, database, workingDirectory, router];

resultStream.Close[];

Feedback.PutF[router, oneLiner, $Feedback, "Statistics written to %g in time (%r)", [rope[fullName]], [integer[printTime]]];

EXITS

FSError => Feedback.Append[router, oneLiner, $Complaint, Rope.Concat["FSError while trying ", fullName]];

END;

};

ProcessScript: PUBLIC PROC [scriptName: Rope.ROPE, resultStream: IO.STREAM, database: Database, workingDirectory: Rope.ROPE ← NIL, router: MsgRouter ← NIL] RETURNS [printTime: INT] = {

fullName, globalName: Rope.ROPE;

success: BOOL ← FALSE;

f: IO.STREAM;

endOfStream: BOOL ← FALSE;

startTime, endTime: BasicTime.GMT;

totalTime: INT;

InitializeDatabase[database];

BEGIN

[fullName, success] ← GGFileOps.GetScriptFileName["ScriptStats", scriptName, workingDirectory, router];

IF NOT success THEN {fullName ← scriptName; GOTO OpenFileProblem};

[f, success] ← OpenExistingFile[fullName, router];

IF NOT success THEN GOTO OpenFileProblem;

startTime ← BasicTime.Now[];

WHILE NOT endOfStream DO

endOfStream ← SessionLog.PlayAction[f, database, ProcessAction];

ENDLOOP;

endTime ← BasicTime.Now[];

totalTime ← BasicTime.Period[startTime, endTime];

Feedback.PutF[router, oneLiner, $Statistics, "Read %g (%r)", [rope[fullName]], [integer[totalTime]]];

startTime ← BasicTime.Now[];

globalName ← FNameToGName[fullName];

resultStream.PutF["Comment ""%g""\n", [rope[globalName]]];

PrintResults[resultStream, database];

endTime ← BasicTime.Now[];

printTime ← BasicTime.Period[startTime, endTime];

EXITS

OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullName, " for playback"]];

END;

};

ProcessOneSummary: PUBLIC PROC [summaryName: Rope.ROPE, totalsName: Rope.ROPE, workingDirectory: Rope.ROPE] = {

success, versionSpecified, alreadyExists: BOOL ← FALSE;

database: Database;

typescript: Viewer;

router: MsgRouter;

Open a typescript

[alreadyExists, typescript] ← FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];

router ← Feedback.CreateRouter[];

FeedbackOps.SetTypescript[router, $ScriptStats];

Initialize the database

database ← CreateDatabase[];

InitializeDatabase[database];

Process the summary and write the new totals to the totals files

ReadOneSummary[summaryName, workingDirectory, database, router];

WriteTotals[totalsName, workingDirectory, database, router];

};

ReadOneSummary: PROC [summaryName: Rope.ROPE, workingDirectory: Rope.ROPE, database: Database, router: MsgRouter] = {

endOfStream: BOOL ← FALSE;

f: IO.STREAM;

fullSummaryName: Rope.ROPE;

success, versionSpecified, alreadyExists: BOOL ← FALSE;

startTime, endTime: BasicTime.GMT;

totalTime: INT;

BEGIN

[fullSummaryName, success, versionSpecified] ← GGFileOps.GetGenericFileName["ScriptStats", summaryName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];

IF NOT success THEN {fullSummaryName ← summaryName; GOTO OpenFileProblem};

[f, success] ← OpenExistingFile[fullSummaryName, router];

IF NOT success THEN GOTO OpenFileProblem;

startTime ← BasicTime.Now[];

WHILE NOT endOfStream DO

endOfStream ← SessionLog.PlayAction[f, database, ProcessSubtotal];

ENDLOOP;

f.Close[];

endTime ← BasicTime.Now[];

totalTime ← BasicTime.Period[startTime, endTime];

Feedback.PutF[router, oneLiner, $Feedback, "Read %g (%r)", [rope[fullSummaryName]], [integer[totalTime]]];

EXITS

OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullSummaryName, " for input"]];

END;

};

WriteTotals: PUBLIC PROC [totalsName: Rope.ROPE, workingDirectory: Rope.ROPE ← NIL, database: Database, router: MsgRouter ← NIL] = {

startTime, endTime: BasicTime.GMT;

printTime: INT;

fullTotalsName: Rope.ROPE;

tKeep: CARDINAL ← 0;

ofile: FS.OpenFile;

totalsStream: IO.STREAM;

success, versionSpecified, alreadyExists: BOOL ← FALSE;

BEGIN

[fullTotalsName, success, versionSpecified] ← GGFileOps.GetGenericFileName["ScriptStats", totalsName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];

tKeep ← FS.FileInfo[name: fullTotalsName ! FS.Error => CONTINUE].keep;

ofile ← FS.Create[name: fullTotalsName, setPages: FALSE, setKeep: TRUE, keep: MAX[tKeep, 2] ! FS.Error => {

GOTO OpenFileProblem;

};];

totalsStream ← FS.StreamFromOpenFile[openFile: ofile, accessRights: $write ! FS.Error => GOTO OpenStreamProblem];

Write the totals onto the totalsStream

startTime ← BasicTime.Now[];

ComputeTotals[database];

PrintTotals[totalsStream, database];

totalsStream.Close[];

endTime ← BasicTime.Now[];

printTime ← BasicTime.Period[startTime, endTime];

Feedback.PutF[router, oneLiner, $Feedback, "Totals written to %g in time (%r)", [rope[fullTotalsName]], [integer[printTime]]];

EXITS

OpenFileProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open ", fullTotalsName, " for totals"]];

OpenStreamProblem => Feedback.Append[router, oneLiner, $Complaint, Rope.Cat["Could not open stream on ", fullTotalsName]];

END;

};

FNameToGName: PROC [name: Rope.ROPE] RETURNS [Rope.ROPE] = {

gHost, gDir: Rope.ROPE ← NIL;

name ← FS.FileInfo[name].fullFName; -- put in []<> format

IF Rope.Match["[]*", name] THEN {

IF gHost = NIL THEN gHost ← Rope.Cat["[", SystemNames.MachineName[], "]"];

IF gDir = NIL THEN

gDir ← Rope.Cat[gHost, "<", File.GetVolumeName[File.SystemVolume[]], ">"];

IF Rope.Match["[]<>*", name]

THEN RETURN [Rope.Replace[base: name, start: 0, len: 4, with: gDir]]

ELSE RETURN [Rope.Replace[base: name, start: 0, len: 2, with: gHost]];

};

RETURN [name];

};

ComputeTotals: PROC [database: Database] = {

Add up all of the actions except those for which system = TRUE; For each of the remaining actions, compute what fraction of the whole it takes up.

AddEmUp: PROC [atom: ATOM] RETURNS [done: BOOL ← FALSE] = {

refAny: REF ANY;

regEvent: RegisteredEvent;

found: BOOL;

headerAtom: ATOM;

Zero Section Headers

headerAtom ← sectionOrderList.first;

sectionOrderList ← sectionOrderList.rest;

IF atom = $SectionHeader THEN {

[found, refAny] ← RefTab.Fetch[database.sectionTable, headerAtom];

IF NOT found THEN ERROR;

sectionEvent ← NARROW[refAny];

sectionEvent.count ← 0;

RETURN;

};

Add Actions to the Totals

[found, refAny] ← RefTab.Fetch[table, atom];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

IF NOT regEvent.system THEN database.atomCount ← database.atomCount + regEvent.count;

sectionEvent.count ← sectionEvent.count + regEvent.count;

};

ComputeFraction: PROC [atom: ATOM] RETURNS [done: BOOL ← FALSE] = {

refAny: REF ANY;

regEvent: RegisteredEvent;

found: BOOL;

realCount: REAL;

headerAtom: ATOM;

Find Header Fractions

headerAtom ← sectionOrderList.first;

sectionOrderList ← sectionOrderList.rest;

IF atom = $SectionHeader THEN {

[found, refAny] ← RefTab.Fetch[database.sectionTable, headerAtom];

IF NOT found THEN ERROR;

sectionEvent ← NARROW[refAny];

realCount ← sectionEvent.count;

sectionEvent.fraction ← realCount/realAtomCount;

RETURN;

};

Find Action Fractions

[found, refAny] ← RefTab.Fetch[table, atom];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

realCount ← regEvent.count;

regEvent.fraction ← realCount/realAtomCount;

};

table: RefTab.Ref ← database.table;

sectionEvent: RegisteredEvent;

realAtomCount: REAL;

sectionOrderList: LIST OF ATOM;

sectionOrderList ← database.sectionOrder.list;

database.atomCount ← 0;

ForEachAtom[database.atomOrder, AddEmUp];

sectionOrderList ← database.sectionOrder.list;

realAtomCount ← database.atomCount;

ForEachAtom[database.atomOrder, ComputeFraction];

};

printAll: BOOL ← FALSE;

PrintTotals: PROC [resultStream: IO.STREAM, database: Database] = {

For each action, print its total and the fraction of the grand total (computed by ComputeTotals) for non-system actions.

For each section header, print its name, its total and the fraction of the grand total.

Finally, print the grand total.

PrintTotalAndFraction: PROC [atom: ATOM] RETURNS [done: BOOL ← FALSE] = {

refAny: REF ANY;

regEvent: RegisteredEvent;

found: BOOL;

headerAtom: ATOM;

Deal with Section Headers

headerAtom ← sectionOrderList.first;

sectionOrderList ← sectionOrderList.rest;

IF atom = $SectionHeader THEN {

headerEvent: RegisteredEvent;

[found, refAny] ← RefTab.Fetch[database.sectionTable, headerAtom];

IF NOT found THEN ERROR;

headerEvent ← NARROW[refAny];

resultStream.PutF["\nSectionHeader %g %g (%6.3f)\n", [rope[Atom.GetPName[headerAtom]]], [integer[headerEvent.count]], [real[headerEvent.fraction]] ];

RETURN;

};

Deal with Other Atoms

[found, refAny] ← RefTab.Fetch[table, atom];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

IF regEvent.count > 0 OR printAll THEN {

resultStream.PutF["%g %g (%6.3f)", [rope[Atom.GetPName[atom]]], [integer[regEvent.count]], [real[regEvent.fraction]] ];

IF regEvent.addOn THEN resultStream.PutF[" AddOn"];

resultStream.PutChar[IO.CR];

};

table: RefTab.Ref ← database.table;

sectionOrderList: LIST OF ATOM ← database.sectionOrder.list;

ForEachAtom[database.atomOrder, PrintTotalAndFraction];

resultStream.PutF["\nTotal %g", [integer[database.atomCount]] ];

};

PrintResults: PROC [resultStream: IO.STREAM, database: Database] = {

For each action, print its total.

PrintAtomResults: PROC [atom: ATOM] RETURNS [done: BOOL ← FALSE] = {

refAny: REF ANY;

regEvent: RegisteredEvent;

found: BOOL;

IF atom = $SectionHeader THEN {resultStream.PutChar[IO.CR]; RETURN};

[found, refAny] ← RefTab.Fetch[table, atom];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

IF regEvent.count > 0 THEN {

resultStream.PutF["%g %g", [rope[Atom.GetPName[atom]]], [integer[regEvent.count]] ];

IF regEvent.addOn THEN resultStream.PutF[" AddOn"];

resultStream.PutChar[IO.CR];

};

table: RefTab.Ref ← database.table;

ForEachAtom[database.atomOrder, PrintAtomResults];

};

InitializeDatabase: PROC [database: Database] = {

InitializeEvent: PROC [key: RefTab.Key, val: RefTab.Val] RETURNS [quit: BOOL ← FALSE] = {

regEvent: RegisteredEvent ← NARROW[val];

regEvent.count ← 0;

regEvent.fraction ← 0.0;

};

[] ← RefTab.Pairs[database.table, InitializeEvent];

[] ← RefTab.Pairs[database.sectionTable, InitializeEvent];

};

ProcessAction: PUBLIC PROC [clientData: REF ANY, event: LIST OF REF ANY] = {

regEvent: RegisteredEvent;

refAny: REF ANY;

found: BOOL;

database: Database ← NARROW[clientData];

atom: ATOM;

table: RefTab.Ref ← database.table;

atom ← NARROW[event.first];

[found, refAny] ← RefTab.Fetch[table, atom];

regEvent ← NARROW[refAny];

IF NOT found THEN {

RegisterAction[atom, database, none];

[found, refAny] ← RefTab.Fetch[table, event.first];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

regEvent.addOn ← TRUE;

};

IF atom = $SetScaleUnit THEN {

IF event.rest.rest.first = $Noisy THEN regEvent.count ← regEvent.count + 1

}

ELSE regEvent.count ← regEvent.count + 1;

};

ProcessSubtotal: PUBLIC PROC [clientData: REF ANY, event: LIST OF REF ANY] = {

regEvent: RegisteredEvent;

refAny: REF ANY;

found: BOOL;

database: Database ← NARROW[clientData];

table: RefTab.Ref ← database.table;

count: CARD;

atom: ATOM;

atom ← NARROW[event.first];

IF atom = $Comment THEN RETURN;

IF atom = $SectionHeader THEN RETURN; -- These are computed from scratch each time

IF atom = $Total THEN RETURN; -- This is computed from scratch each time

[found, refAny] ← RefTab.Fetch[table, atom];

regEvent ← NARROW[refAny];

Handle AddOns

IF NOT found THEN {

RegisterAction[atom, database, none];

[found, refAny] ← RefTab.Fetch[table, event.first];

IF NOT found THEN ERROR;

regEvent ← NARROW[refAny];

regEvent.addOn ← TRUE;

};

Update the Count

count ← NARROW[event.rest.first, REF INT]^;

regEvent.count ← regEvent.count + count;

};

OpenExistingFile: PROC [name: Rope.ROPE, router: MsgRouter ← NIL] RETURNS [f: IO.STREAM, success: BOOL] = {

success ← TRUE;

Two possiblilities

1) File doesn't exist. Print error message.

2) File does exist. File it in. Succeed.

f ← FS.StreamOpen[name

! FS.Error => {

success ← FALSE;

Feedback.Append[router, oneLiner, $Complaint, error.explanation];

CONTINUE};

];

};

RegisterAction: PROC [atom: ATOM, database: Database, argType: ArgumentType, system: BOOL ← FALSE] = {

ensureUnique: BOOL = TRUE;

notAlreadyRegistered: BOOL;

table: RefTab.Ref ← database.table;

regEvent: RegisteredEvent ← NEW[RegisteredEventObj ← [argType, 0, 0.0, FALSE, system]];

notAlreadyRegistered ← RefTab.Insert[table, atom, regEvent];

IF NOT notAlreadyRegistered THEN {

IF ensureUnique THEN SIGNAL Problem[msg: IO.PutFR["Event %g was already registered in Gargoyle's event table.", [rope[Atom.GetPName[atom]]]]]

ELSE [] ← RefTab.Replace[table, atom, regEvent]; -- register again

}

ELSE {

AppendAtom[atom, database.atomOrder];

AppendAtom[NIL, database.sectionOrder];

};

SectionHeader: PROC [sectionName: Rope.ROPE, headerAtom: ATOM, database: Database] = {

notAlreadyRegistered: BOOL;

sectionTable: RefTab.Ref ← database.sectionTable;

regEvent: RegisteredEvent ← NEW[RegisteredEventObj ← [none, 0, 0.0, FALSE, TRUE, sectionName]];

notAlreadyRegistered ← RefTab.Insert[sectionTable, headerAtom, regEvent];

IF NOT notAlreadyRegistered THEN {

SIGNAL Problem[msg: IO.PutFR["Section %g was already registered in Gargoyle's event table.", [rope[Atom.GetPName[headerAtom]]]]];

};

AppendAtom[$SectionHeader, database.atomOrder];

AppendAtom[headerAtom, database.sectionOrder];

};

CreateDatabase: PUBLIC PROC [] RETURNS [database: Database] = {

table: RefTab.Ref ← RefTab.Create[350];

sectionTable: RefTab.Ref ← RefTab.Create[25];

database ← NEW[DatabaseObj ← [

table: table,

atomOrder: NewAtomListt[],

lastAtom: NIL,

atomCount: 0,

sectionTable: sectionTable,

sectionOrder: NewAtomListt[]

]];

RegisterActions[database];

};

RegisterActions: PROC [database: Database] = {

There were 263 events on September 22, 1987

There were 295 events on September 26, 1987

SectionHeader["Selecting and Graphical Find", $SelectAndFind, database];

RegisterAction[$CycleSelection, database, none];

RegisterAction[$AreaSelectNew, database, none];

RegisterAction[$AreaSelectNewAndDelete, database, none];

RegisterAction[$AreaSelectExtend, database, none];

RegisterAction[$SelectAll, database, none];

RegisterAction[$AreaSelectDegenerate, database, none];

RegisterAction[$SelectCoincident, database, none];

RegisterAction[$SelectUnseeableSegs, database, none];

RegisterAction[$SelectUnseeableObjs, database, none];

RegisterAction[$SelectMatchingWidth, database, refReal];

RegisterAction[$SelectMatchingDashes, database, rope];

RegisterAction[$SelectMatchingAreaRGB, database, rope];

RegisterAction[$SelectMatchingAreaCNS, database, rope];

RegisterAction[$SelectMatchingLineRGB, database, rope];

RegisterAction[$SelectMatchingLineCNS, database, rope];

RegisterAction[$MatchAll, database, none];

RegisterAction[$MatchSelectedName, database, rope];

RegisterAction[$MatchSelectedNameLiteral, database, rope];

RegisterAction[$SelectMatchingCurve, database, rope];

RegisterAction[$StartSelectWithBox, database, none];

RegisterAction[$StartSelectJoint, database, none];

RegisterAction[$StartExtSelectJoint, database, none];

RegisterAction[$StartSelectSegment, database, none];

RegisterAction[$StartExtSelectSegment, database, none];

RegisterAction[$StartSelectTrajectory, database, none];

RegisterAction[$StartExtSelectTrajectory, database, none];

RegisterAction[$StartSelectTopLevel, database, none];

RegisterAction[$StartExtSelectTopLevel, database, none];

RegisterAction[$StartExtendSelection, database, none];

RegisterAction[$StartDeselectJoint, database, none];

RegisterAction[$StartDeselectSegment, database, none];

RegisterAction[$StartDeselectTrajectory, database, none];

RegisterAction[$StartDeselectTopLevel, database, none];

SectionHeader["Adding and Deleting Geometry", $AddGeometry, database];

RegisterAction[$Delete, database, none];

RegisterAction[$DeleteCaretSegment, database, none];

RegisterAction[$AddChar, database, none];

RegisterAction[$AddText, database, rope];

RegisterAction[$NewCircle, database, none];

RegisterAction[$NewBox, database, none];

RegisterAction[$Frame, database, none];

RegisterAction[$UnionCombine, database, none];

RegisterAction[$FitCurves, database, none];

RegisterAction[$FitLines, database, none];

RegisterAction[$FitOutlineEdges, database, none];

RegisterAction[$FitOutlineSplines, database, none];

RegisterAction[$FitCenterLineSplines, database, none];

RegisterAction[$AddHoles, database, none];

RegisterAction[$Close, database, none];

RegisterAction[$Weld, database, none];

RegisterAction[$AddControlPoint, database, none];

RegisterAction[$DeleteControlPoint, database, none];

RegisterAction[$AddJoint, database, none];

RegisterAction[$SplitSegment, database, none];

RegisterAction[$Splice, database, none];

RegisterAction[$PolygonInCircle, database, refInt];

RegisterAction[$KnotchedLine, database, none];

RegisterAction[$NewArrow, database, none];

RegisterAction[$SetStraight, database, none];

RegisterAction[$SetArc, database, none];

RegisterAction[$SetSnowflake, database, none];

RegisterAction[$SetConic, database, refReal];

RegisterAction[$SetBezier, database, none];

RegisterAction[$SetConstrainedBezier, database, none];

RegisterAction[$SetNaturalSpline, database, none];

RegisterAction[$SetBSpline, database, none];

SectionHeader["Interactive Adding Geometry", $InteractiveAddGeometry, database];

RegisterAction[$StartCaretPos, database, none];

RegisterAction[$StartAdd, database, none];

RegisterAction[$StartBezier, database, none];

RegisterAction[$StartBox, database, none];

RegisterAction[$StartCopyAndDrag, database, none];

SectionHeader["Interactive Transforming", $InteractiveTransforming, database];

RegisterAction[$StartDrag, database, none];

RegisterAction[$StartRotate, database, none];

RegisterAction[$StartScale, database, none];

RegisterAction[$StartSixPoint, database, none];

SectionHeader["Transforming", $Transforming, database];

RegisterAction[$Rotate, database, rope];

RegisterAction[$UnRotate, database, rope];

RegisterAction[$Scale, database, rope];

RegisterAction[$UnScale, database, rope];

RegisterAction[$ScaleX, database, rope];

RegisterAction[$UnScaleX, database, rope];

RegisterAction[$ScaleY, database, rope];

RegisterAction[$UnScaleY, database, rope];

RegisterAction[$ScaleXY, database, rope];

RegisterAction[$TranslateX, database, rope];

RegisterAction[$TranslateY, database, rope];

RegisterAction[$TranslateXY, database, rope];

RegisterAction[$SixPointTransform, database, none];

RegisterAction[$FourPointTransform, database, none];

RegisterAction[$SetMakeConstrained, database, none];

SectionHeader["Viewing", $Viewing, database];

RegisterAction[$ScalePop, database, rope2];

RegisterAction[$RotatePop, database, rope2];

RegisterAction[$FitPop, database, none];

RegisterAction[$ResetPop, database, none];

RegisterAction[$EdgePop, database, none];

RegisterAction[$PrevTransform, database, none];

RegisterAction[$CenterSel, database, none];

RegisterAction[$FitSel, database, none];

RegisterAction[$SetBiScrollersTransform, database, rope];

RegisterAction[$ShowBiScrollersTransform, database, none];

RegisterAction[$AlignFracs, database, none];

RegisterAction[$Shift, database, none];

SectionHeader["Style", $Style, database];

RegisterAction[$ApplyAllDefaults, database, none];

RegisterAction[$LineWidth, database, refReal];

RegisterAction[$LineEnd, database, rope];

RegisterAction[$TrajJoints, database, rope];

RegisterAction[$DashesFromSelection, database, rope];

RegisterAction[$DashesOff, database, none];

RegisterAction[$Arrows, database, none];

RegisterAction[$AreaColorFromColorTool, database, none];

RegisterAction[$AreaColorFollowColorTool, database, none];

RegisterAction[$AreaColorFromSelectedName, database, rope];

RegisterAction[$AreaColorFromSelectedRGB, database, rope];

RegisterAction[$AreaColorBlack, database, none];

RegisterAction[$AreaColorWhite, database, none];

RegisterAction[$AreaColorGray, database, none];

RegisterAction[$AreaColorNone, database, none];

RegisterAction[$LineColorFromColorTool, database, none];

RegisterAction[$LineColorFollowColorTool, database, none];

RegisterAction[$LineColorFromSelectedName, database, rope];

RegisterAction[$LineColorFromSelectedRGB, database, rope];

RegisterAction[$LineColorBlack, database, none];

RegisterAction[$LineColorWhite, database, none];

RegisterAction[$LineColorGray, database, none];

RegisterAction[$LineColorNone, database, none];

RegisterAction[$SetAmplifySpace, database, refReal];

RegisterAction[$AmplifySpaceFromSelection, database, refReal];

RegisterAction[$SetDropShadow, database, none];

RegisterAction[$DropShadowFromSelection, database, refReal];

RegisterAction[$DropShadowOff, database, none];

RegisterAction[$SetPressFont, database, rope];

RegisterAction[$SetPrintFont, database, rope];

RegisterAction[$SetScreenFont, database, rope];

RegisterAction[$SetFontDetailed, database, rope];

RegisterAction[$SetFontLiteral, database, rope];

RegisterAction[$CopyFont, database, none];

RegisterAction[$CopyAll, database, none];

SectionHeader["Set State", $SetState, database];

RegisterAction[$SetAllDefaults, database, none];

RegisterAction[$StandardDefaults, database, none];

RegisterAction[$SetDefaultStrokeValues, database, none];

RegisterAction[$AreaColorToColorTool, database, none];

RegisterAction[$SetDefaultFillColor, database, none];

RegisterAction[$LineColorToColorTool, database, none];

RegisterAction[$SetDefaultLineColor, database, none];

RegisterAction[$SetDefaultTextLooks, database, none];

RegisterAction[$SetDefaultFontValues, database, none];

RegisterAction[$RadiusUnitFromSegment, database, none];

RegisterAction[$RadiusUnitFromValue, database, none];

RegisterAction[$RadiusUnitFromSelection, database, refReal];

RegisterAction[$InchScaleUnit, database, none];

RegisterAction[$SetScaleUnit, database, none];

RegisterAction[$ToggleShowColors, database, none];

RegisterAction[$ScreenChoiceChange, database, none];

RegisterAction[$SetConstraintType, database, none];

RegisterAction[$SetFitTolerance, database, refReal];

RegisterAction[$SetFitParameters, database, rope];

RegisterAction[$SetFitPolyPenalty, database, refReal];

RegisterAction[$SetFitAngle, database, refReal];

RegisterAction[$SetFitThreshold, database, refReal];

RegisterAction[$SetFitIterations, database, refInt];

RegisterAction[$SetFitMinDistance, database, refReal];

SectionHeader["Set Snap-Dragging State", $SetSnapState, database];

RegisterAction[$GravityChoiceChange, database, none];

RegisterAction[$GravityExtentChange, database, none];

RegisterAction[$ToggleGravity, database, none];

RegisterAction[$ToggleShowAlignments, database, none];

RegisterAction[$MakeHot, database, none];

RegisterAction[$MakeAllHot, database, none];

RegisterAction[$MakeCold, database, none];

RegisterAction[$MakeAllCold, database, none];

RegisterAction[$ShowHot, database, none];

RegisterAction[$HideHot, database, none];

RegisterAction[$DropAnchor, database, none];

RegisterAction[$LiftAnchor, database, none];

RegisterAction[$StandardAlignments, database, none];

RegisterAction[$SlopePrompt, database, none];

RegisterAction[$AddSlope, database, none];

RegisterAction[$GetSlope, database, none];

RegisterAction[$ToggleSlope, database, none];

RegisterAction[$DeleteSlope, database, none];

RegisterAction[$AnglePrompt, database, none];

RegisterAction[$AddAngle, database, none];

RegisterAction[$GetAngle, database, none];

RegisterAction[$ToggleAngle, database, none];

RegisterAction[$DeleteAngle, database, none];

RegisterAction[$RadiusPrompt, database, none];

RegisterAction[$AddRadius, database, none];

RegisterAction[$GetRadius, database, none];

RegisterAction[$ToggleRadius, database, none];

RegisterAction[$DeleteRadius, database, none];

RegisterAction[$DistancePrompt, database, none];

RegisterAction[$AddDistance, database, none];

RegisterAction[$GetDistance, database, none];

RegisterAction[$ToggleDistance, database, none];

RegisterAction[$DeleteDistance, database, none];

RegisterAction[$MeasureSlopeFromSelection, database, refReal];

RegisterAction[$MeasureAngleFromSelection, database, refReal];

RegisterAction[$MeasureRadiusFromSelection, database, refReal];

RegisterAction[$MeasureLineDistFromSelection, database, refReal];

RegisterAction[$MeasureSlopeHit, database, none];

RegisterAction[$MeasureAngleHit, database, none];

RegisterAction[$MeasureRadiusHit, database, none];

RegisterAction[$MeasureLineDistHit, database, none];

RegisterAction[$AllAlignmentsOff, database, none];

RegisterAction[$ToggleMidpoints, database, none];

RegisterAction[$ToggleHeuristics, database, none];

SectionHeader["File Operations", $FileOperations, database];

RegisterAction[$Clear, database, none];

RegisterAction[$Reset, database, none];

RegisterAction[$Get, database, rope];

RegisterAction[$MergeAll, database, rope];

RegisterAction[$MergeShapes, database, rope];

RegisterAction[$MergeOptions, database, rope];

RegisterAction[$MergeAlignments, database, rope];

RegisterAction[$Store, database, rope];

RegisterAction[$Save, database, none];

RegisterAction[$StuffToTioga, database, none];

RegisterAction[$StuffToTiogaAlt, database, none];

RegisterAction[$StuffToTiogaBordered, database, none];

RegisterAction[$StuffToTiogaFit, database, none];

RegisterAction[$StuffToTiogaBorderedAndFit, database, none];

RegisterAction[$StuffToFile, database, rope];

RegisterAction[$GetFromTioga, database, none];

RegisterAction[$GrabFromTioga, database, none];

RegisterAction[$MergeFromTioga, database, none];

RegisterAction[$IPToTioga, database, none];

RegisterAction[$IPToTiogaBordered, database, none];

RegisterAction[$IPToTiogaFit, database, none];

RegisterAction[$IPToTiogaBorderedAndFit, database, none];

RegisterAction[$IPToTiogaAlt, database, none];

RegisterAction[$IPMergeFromTioga, database, none];

RegisterAction[$MergeIPEditable, database, rope];

RegisterAction[$MergeIPSlice, database, rope];

RegisterAction[$ToIP, database, rope];

RegisterAction[$ToIPScreen, database, rope];

RegisterAction[$IncludeIPByReference, database, none];

RegisterAction[$IncludeIPByValue, database, none];

RegisterAction[$ShowIPIncludeMode, database, none];

RegisterAction[$ToIPLit, database, none];

RegisterAction[$IPSnapShot, database, none];

SectionHeader["Overlap Order", $OverlapOrder, database];

RegisterAction[$Top, database, none];

RegisterAction[$ShowPriorityValue, database, none];

RegisterAction[$Bottom, database, none];

RegisterAction[$UpOne, database, none];

RegisterAction[$FindPriorityFromSelection, database, refInt];

RegisterAction[$DownOne, database, none];

RegisterAction[$PutInFront, database, none];

RegisterAction[$Exchange, database, none];

RegisterAction[$PutBehind, database, none];

RegisterAction[$UpFromSelection, database, refInt];

RegisterAction[$PutAtSelection, database, refInt];

RegisterAction[$DownFromSelection, database, refInt];

SectionHeader["Groups", $Groups, database];

RegisterAction[$AddToGroup, database, none];

RegisterAction[$SelectGroup, database, none];

RegisterAction[$RemoveFromGroup, database, none];

RegisterAction[$PrintGroupsOfSelected, database, none];

RegisterAction[$PrintAllGroups, database, none];

SectionHeader["Browse State", $BrowseState, database];

RegisterAction[$Help, database, none];

RegisterAction[$DescribeCurve, database, none];

RegisterAction[$ShowAllDefaults, database, none];

RegisterAction[$Typescript, database, none];

RegisterAction[$PrintStrokeValues, database, none];

RegisterAction[$ShowDefaultStrokeValues, database, none];

RegisterAction[$PrintAreaColor, database, none];

RegisterAction[$ShowDefaultFillColor, database, none];

RegisterAction[$PrintLineColor, database, none];

RegisterAction[$ShowDefaultLineColor, database, none];

RegisterAction[$PrintAmplifySpace, database, none];

RegisterAction[$PrintDropShadow, database, none];

RegisterAction[$ShowDefaultTextLooks, database, none];

RegisterAction[$ShowFontValues, database, none];

RegisterAction[$ShowFontValuesLiteral, database, none];

RegisterAction[$ShowDefaultFontValues, database, none];

RegisterAction[$PrintScaleUnit, database, none];

RegisterAction[$ShowConstraintType, database, none];

RegisterAction[$ShowFitParameters, database, none];

SectionHeader["Special Actions", $SpecialActions, database];

RegisterAction[$Again, database, none];

RegisterAction[$Undelete, database, none];

RegisterAction[$UndeleteAutoConfirm, database, none];

RegisterAction[$ScriptAction, database, none];

RegisterAction[$ShowScripts, database, none];

RegisterAction[$Abort, database, none];

SectionHeader["Internal Actions", $InternalActions, database];

RegisterAction[$Version, database, none, TRUE];

RegisterAction[$PaintActionArea, database, none, TRUE];

RegisterAction[$NoOp, database, none, TRUE];

RegisterAction[$DisableRefresh, database, none, TRUE];

RegisterAction[$EnableRefresh, database, none, TRUE];

RegisterAction[$SetDefaultFillColorFromRope, database, rope, TRUE];

RegisterAction[$SetDefaultLineColorFromRope, database, rope, TRUE];

RegisterAction[$SetDefaultFont, database, none, TRUE];

RegisterAction[$SetGravityChoice, database, none, TRUE];

RegisterAction[$SetShowAlignments, database, none, TRUE];

RegisterAction[$EndOfSessionLogMessage, database, none, TRUE];

RegisterAction[$PrintRope, database, none, TRUE];

RegisterAction[$SetGravityExtent, database, none, TRUE];

RegisterAction[$SetGravity, database, none, TRUE];

RegisterAction[$SetMidpoints, database, none, TRUE];

RegisterAction[$SetHeuristics, database, none, TRUE];

RegisterAction[$SetShowColors, database, none, TRUE];

RegisterAction[$SawTextFinish, database, none, TRUE];

RegisterAction[$SawMouseFinish, database, none, TRUE];

RegisterAction[$SetCaretPosition, database, none, TRUE];

RegisterAction[$SetCaretNormal, database, none, TRUE];

RegisterAction[$SetDisplayStyle, database, none, TRUE];

RegisterAction[$InitializeAlignments, database, none, TRUE]; -- now obsolete

RegisterAction[$SetSlopes, database, none, TRUE];

RegisterAction[$SetAngles, database, none, TRUE];

RegisterAction[$SetRadii, database, none, TRUE];

RegisterAction[$SetDistances, database, none, TRUE];

RegisterAction[$AllUp, database, none, TRUE];

RegisterAction[$GuardUp, database, none, TRUE];

RegisterAction[$MouseUp, database, none, TRUE];

RegisterAction[$During, database, none, TRUE];

SectionHeader["Debugging Actions", $DebuggingActions, database];

RegisterAction[$Refresh, database, none];

RegisterAction[$TestGravity, database, refInt];

RegisterAction[$ToIPTestGravity, database, rope];

RegisterAction[$TestMultiGravity, database, none];

RegisterAction[$Statistics, database, none];

RegisterAction[$PrintSelectedStatistic, database, rope];

RegisterAction[$ResetStatistics, database, none];

RegisterAction[$DrawTightBoxes, database, none];

RegisterAction[$DrawBoundBoxes, database, none];

RegisterAction[$DrawOutlineBoxes, database, none];

RegisterAction[$DrawSelectionBox, database, none];

RegisterAction[$DrawBackgroundBox, database, none];

RegisterAction[$DrawOverlayBox, database, none];

RegisterAction[$DrawRubberBox, database, none];

RegisterAction[$DrawDragBox, database, none];

RegisterAction[$SlackLog, database, none];

RegisterAction[$DescribeCaretObject, database, none];

RegisterAction[$FSMInfo, database, none];

RegisterAction[$PrintAllInput, database, none];

RegisterAction[$ResetAllInput, database, none];

RegisterAction[$CauseAnError, database, none];

RegisterAction[$ReloadTipTable, database, none];

SectionHeader["Other", $OtherHeader, database];

RegisterAction[$MatchFetch, database, none];

RegisterAction[$MatchSearchOpChange, database, none];

RegisterAction[$MatchToggle, database, none];

};

NewAtomListt: PUBLIC PROC [] RETURNS [listt: AtomListt] = {

listt ← NEW[AtomListtObj ← [NIL, NIL]];

};

AppendAtom: PUBLIC PROC [atom: ATOM, listt: AtomListt] = {

IF listt.tail = NIL THEN {

IF NOT listt.list = NIL THEN ERROR;

listt.tail ← listt.list ← LIST[atom];

}

ELSE {

listt.tail.rest ← LIST[atom];

listt.tail ← listt.tail.rest;

};

ForEachAtom: PUBLIC PROC [listt: AtomListt, eachAtomProc: EachAtomProc] = {

done: BOOL ← FALSE;

FOR list: LIST OF ATOM ← listt.list, list.rest UNTIL list = NIL DO

done ← eachAtomProc[list.first];

IF done THEN RETURN;

ENDLOOP;

};

EachAtomProc: TYPE = PROC [atom: ATOM] RETURNS [done: BOOL ← FALSE];

GGScript: Commander.CommandProc = {

cmd.out.PutF["GGToIP not yet implemented"];

EachFile: FS.NameProc = {

[fullFName: ROPE] RETURNS [continue: BOOL]

printTime: INT;

printTime ← ProcessScript[fullFName, resultStream, database, workingDirectory, router];

resultStream.PutChar[IO.CR];

Feedback.PutF[router, oneLiner, $Feedback, "Wrote %g (%r)", [rope[resultFullName]], [integer[printTime]]];

continue ← TRUE;

};

TryPattern: PROC [pattern: Rope.ROPE] = {

ENABLE FS.Error => IF error.group # $bug THEN {

IO.PutRope[out, " -- "];

IO.PutRope[out, error.explanation];

GO TO err};

pattern ← FileNames.ResolveRelativePath[pattern];

pattern ← FS.ExpandName[pattern].fullFName;

IF NOT Rope.Match["*!*", pattern] THEN pattern ← Rope.Concat[pattern, "!h"];

FS.EnumerateForNames[pattern, EachFile];

EXITS

err => {IO.PutRope[out, "\n"]; RETURN};

};

out: IO.STREAM ← cmd.out;

argv: CommandTool.ArgumentVector;

success, versionSpecified, alreadyExists: BOOL ← FALSE;

database: Database;

typescript: Viewer;

router: MsgRouter;

resultShortName, resultFullName, arrow: Rope.ROPE;

workingDirectory: Rope.ROPE ← FileNames.CurrentWorkingDirectory[];

resultStream: IO.STREAM;

BEGIN

argv ← CommandTool.Parse[cmd: cmd

! CommandTool.Failed => {msg ← errorMsg; GO TO failed}];

[alreadyExists, typescript] ← FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];

router ← Feedback.CreateRouter[];

FeedbackOps.SetTypescript[router, $ScriptStats];

resultShortName ← argv[1];

arrow ← argv[2];

[resultFullName, success, versionSpecified] ← GGFileOps.GetGenericFileName["ScriptStats", resultShortName, workingDirectory, "stats", LIST["gargoyle", "ip", "script"], router];

resultStream ← FS.StreamOpen[resultFullName, $create ! FS.Error => GOTO FSError];

database ← CreateDatabase[];

FOR i: NAT IN [3..argv.argc) DO

arg: Rope.ROPE = argv[i];

IF Rope.Length[arg] = 0 THEN LOOP;

TryPattern[arg];

ENDLOOP;

resultStream.Close[];

EXITS

failed => {result ← $Failure};

FSError => Feedback.Append[router, oneLiner, $Complaint, Rope.Concat["FSError while trying ", resultFullName]];

END;

};

GGTotal: Commander.CommandProc = {

EachFile: FS.NameProc = {

[fullFName: ROPE] RETURNS [continue: BOOL]

ReadOneSummary[fullFName, workingDirectory, database, router];

continue ← TRUE;

};

TryPattern: PROC [pattern: Rope.ROPE] = {

ENABLE FS.Error => IF error.group # $bug THEN {

IO.PutRope[out, " -- "];

IO.PutRope[out, error.explanation];

GO TO err};

pattern ← FileNames.ResolveRelativePath[pattern];

pattern ← FS.ExpandName[pattern].fullFName;

IF NOT Rope.Match["*!*", pattern] THEN pattern ← Rope.Concat[pattern, "!h"];

FS.EnumerateForNames[pattern, EachFile];

EXITS

err => {IO.PutRope[out, "\n"]; RETURN};

};

out: IO.STREAM ← cmd.out;

argv: CommandTool.ArgumentVector;

success, versionSpecified, alreadyExists: BOOL ← FALSE;

database: Database;

typescript: Viewer;

router: MsgRouter;

totalsName, arrow: Rope.ROPE;

workingDirectory: Rope.ROPE ← FileNames.CurrentWorkingDirectory[];

BEGIN

argv ← CommandTool.Parse[cmd: cmd

! CommandTool.Failed => {msg ← errorMsg; GO TO failed}];

[alreadyExists, typescript] ← FeedbackOps.CreateNamedTypescript[headerText: "Script Statistics", typescriptName: $ScriptStats, openHeight: 120];

router ← Feedback.CreateRouter[];

FeedbackOps.SetTypescript[router, $ScriptStats];

totalsName ← argv[1];

arrow ← argv[2];

database ← CreateDatabase[];

InitializeDatabase[database];

FOR i: NAT IN [3..argv.argc) DO

arg: Rope.ROPE = argv[i];

IF Rope.Length[arg] = 0 THEN LOOP;

TryPattern[arg];

ENDLOOP;

WriteTotals[totalsName, workingDirectory, database, router];

EXITS

failed => {result ← $Failure};

END;

};

Init: PROC = {

Commander.Register[

key: "GGScript",

proc: GGScript,

doc: "GGScript resultName.stats ← <file pattern>",

clientData: NIL

];

Commander.Register[

key: "GGTotal",

proc: GGTotal,

doc: "GGTotal resultName.stats ← <file pattern>",

clientData: NIL

];

};

Init[];

END.