-- file:  InstallLaurel.Mesa
-- edited by Levin, January 16, 1981  11:14 AM.
-- edited by Brotz, March 7, 1983  4:04 PM
-- edited by Schroeder,  March 14, 1981  12:36 PM.
-- edited by Taft, May 10, 1983  6:31 PM

DIRECTORY
  AltoDefs USING [BytesPerPage, PageCount, PageNumber, PageSize],
  AltoDisplay USING [MaxScanLines],
  AltoFileDefs USING [fillinDA, FP, LD, NullFP, vDA],
  Ascii USING [ControlZ, CR, TAB],
  BFSDefs USING [ActOnPages, GetNextDA],
  ccD: FROM "ChollaCmdDefs" USING [ChollaMailProcess],
  ControlDefs USING [FrameCodeBase, GlobalFrame, GlobalFrameHandle, MainBodyIndex,
    PrefixHandle],
  Core USING [FreeCacheEntry, InsertInFileCache, LookupInFileCache],
  csD: FROM "CoreStreamDefs" USING [Close, EndOfStream, GetLength, GetPosition,
    OpenFromName, Position, Read, ReadBlock, SetPosition, StreamHandle, Write,
    WriteBlock],
  DiskDefs USING [DiskRequest],
  displayCommon USING [bitMapReady, charPropertyTable],
  DMSTimeDefs USING [MapPackedTimeToTimeZoneString, timeStringLength],
  drD: FROM "LaurelDriverDefs" USING [InstallError],
  dsD: FROM "DisplayDefs" USING [backgtype, CursorBitMap, cursorBM, LegalCharacters,
    lineHeight],
  exD: FROM "ExceptionDefs" USING [SysBug],
  FrameDefs USING [GlobalFrame, IsBound],
  FrameOps USING [CodeHandle],
  inD: FROM "InteractorDefs" USING [BoundarySetArray, BuildScreenStructures,
    leftMargin, TextSelection],
  Inline USING [COPY, LowHalf],
  intCommon USING [actionPoint, audioEnabled, autoConfirm, bluePendingDelete,
    boundarySet, bugReportee, cForCopies, chollaArchiveFilePath, chollaDL, cmTextNbr,
    commandMode, commandType, composedMessageEdited, continuousScrollDelay,
    continuousScrollTimeOut, controlRedEnabled, currentCommand, currentSelection,
    dateLeftX, dateRightX, defaultHardCopies, defaultHardcopyFormName,
    deliverCommandVisible, deliverWithCR, disableWriting, displayAfterDelete,
    editorMenuState, editorType, exceptionType, fromLeftX, fromRightX, gvTestingMode,
    hardCopies, hardcopyHost, hardcopyInstallError, hardcopyUserName, imageFileName,
    isCholla, leafOk, mailcheckPollingInterval, multiClickTimeOut, newFormAfterDelivery,
    newMailTune, nextBracketDelay, nextBracketTimeout, numScanLines, passwordPrinting,
    passwordPrintingDefault, pendingDeleteSetByControl, profileRegistry, profileRetrieve,
    profileRetrieveMode, profileSend, profileSendMode, remoteFilePath, runCommandMode,
    runPath, secondarySelectionEnabled, source, subjectExtensionLeftX, subjectLeftX,
    tapTimeOut, target, timeMayBeBogus, twoSidedPrinting, twoSidedPrintingDefault,
    workstationName],
  LaurelHardcopyDefs USING [FontCode, FontError, InitHardcopyFonts, InstallHardcopy,
    ParseFont, ParseHardcopyForm],
  lsD: FROM "LaurelStateDefs" USING [AllocateStateNode, AllocateStateString,
    DefineStateSegment, GetWrittenTime, InstallSegments, PageCount, PageNumber,
    ReleaseStateSegment, StateHeader, SwapInStateSegment, WriteStateSegment],
  MailParseDefs USING [FinalizeParse, GetFieldBody, GetFieldName, InitializeParse,
    ParseError, ParseHandle, ParseNameList],
  MiscDefs USING [SetBlock],
  ovD: FROM "OverviewDefs" USING [LineBreakValue],
  SegmentDefs USING [CopyDataToFileSegment, DataSegmentAddress, DataSegmentHandle,
    DefaultAccess, DefaultBase, DeleteDataSegment, DeleteFileSegment, FileHandle,
    FileSegmentAddress, FileSegmentHandle, GetEndOfFile, GetFileSegmentDA, InsertFile,
    NewDataSegment, NewFile, NewFileSegment, OldFileOnly, PageCount,
    PageFromAddress, PageNumber, Read, ReadWrite, ReadWriteAppend, SetEndOfFile,
    SwapIn, Unlock, Write],
  Storage USING [PagesForWords, StringLength],
  StringDefs USING [AppendDecimal, AppendString, BcplSTRING, BcplToMesaString,
    EquivalentString, InvalidNumber, StringToDecimal, WordsForString],
  SwapperOps USING [FreePage, Update],
  TimeDefs USING [CurrentDayTime],
  VMDefs USING [CantOpen, CloseFile, OpenFile];

InstallLaurel: PROGRAM
  IMPORTS BFSDefs, ccD, Core, csD, disC: displayCommon, DMSTimeDefs, exD, Inline,
    intC: intCommon, inD, FrameDefs, FrameOps, LaurelHardcopyDefs, lsD,
    MailParseDefs, MiscDefs, SegmentDefs, Storage, StringDefs, SwapperOps, TimeDefs,
    VMDefs
  EXPORTS drD, lsD
  SHARES lsD =

BEGIN
OPEN drD;

stateFH: SegmentDefs.FileHandle;
stateHeaderSeg: SegmentDefs.FileSegmentHandle;
stateHeader: POINTER TO lsD.StateHeader;
stateSegPages: AltoDefs.PageCount;

heapFirstFree: POINTER;
heapLimit: POINTER;

profileInUserCm: BOOLEAN;

videoBackground: PUBLIC dsD.backgtype;

log: csD.StreamHandle _ NIL;
logStartPosition: csD.Position;


InitializeState: PROCEDURE[imageFile: SegmentDefs.FileHandle,
  heapDS: SegmentDefs.DataSegmentHandle] =
BEGIN
OPEN SegmentDefs;

GetGlobalFrameSize: PROCEDURE[link: UNSPECIFIED] RETURNS [length: CARDINAL] =
  BEGIN
  OPEN ControlDefs;
  frame: GlobalFrameHandle _ FrameDefs.GlobalFrame[link];
  codeSeg: FileSegmentHandle _ FrameOps.CodeHandle[frame];
  seg: FileSegmentHandle _
    NewFileSegment[codeSeg.file, codeSeg.base, codeSeg.pages, Read];
  fcb: FrameCodeBase _ frame.code;
  prefix: PrefixHandle;
  p: POINTER;
  SwapIn[seg];
  IF fcb.out THEN fcb.out _ FALSE
  ELSE
    fcb.shortbase _ fcb.shortbase - LOOPHOLE[FileSegmentAddress[codeSeg], CARDINAL];
  prefix _ p _ FileSegmentAddress[seg] + fcb.offset;
  length _ (p+prefix.entry[MainBodyIndex].initialpc-1)^;
  Unlock[seg];
  DeleteFileSegment[seg];
  END;  -- of GetGlobalFrameSize --

intCLength: CARDINAL = GetGlobalFrameSize[intC] - SIZE[ControlDefs.GlobalFrame];
disCLength: CARDINAL = GetGlobalFrameSize[disC] - SIZE[ControlDefs.GlobalFrame];
imageFileLength: CARDINAL = GetEndOfFile[imageFile].page;
daTableLength: CARDINAL = imageFileLength + 3;
diskrequest: DiskDefs.DiskRequest;
scratchSeg: DataSegmentHandle = NewDataSegment[DefaultBase, 1];
DAs: DESCRIPTOR FOR ARRAY [-1 .. 0) OF AltoFileDefs.vDA;
stateFP: AltoFileDefs.FP;
stateFileName: STRING = "Laurel.state"L;

heapLimit _ DataSegmentAddress[heapDS];
heapFirstFree _ heapLimit + AltoDefs.PageSize * heapDS.pages - 1;
IF (stateFP _ Core.LookupInFileCache[stateFileName]) = AltoFileDefs.NullFP THEN
  BEGIN
  VMDefs.CloseFile[VMDefs.OpenFile[name: stateFileName, options: new]];
  stateFH _ NewFile[stateFileName, ReadWriteAppend, OldFileOnly];
  [] _ Core.InsertInFileCache[stateFileName, stateFH.fp, TRUE];
  END
ELSE stateFH _ InsertFile[@stateFP, ReadWriteAppend];
stateSegPages _ Storage.PagesForWords[SIZE[lsD.StateHeader] + intCLength + disCLength];
SetEndOfFile[stateFH, stateSegPages, AltoDefs.BytesPerPage];
stateHeaderSeg _ NewFileSegment[stateFH, 1, stateSegPages, ReadWrite];
SwapIn[stateHeaderSeg];
stateHeader _ FileSegmentAddress[stateHeaderSeg];

stateHeader.cachedHeapTop _ heapDS.VMpage + heapDS.pages;
stateHeader.imageFP _ imageFile.fp;
stateHeader.imageTime _ lsD.GetWrittenTime[imageFile];
stateHeader.intCOffset _ SIZE[lsD.StateHeader];
stateHeader.disCOffset _ stateHeader.intCOffset + intCLength;
stateHeader.headerFF _ stateHeader.disCOffset + disCLength;
stateHeader.imageDATableSeg _
  lsD.DefineStateSegment[Storage.PagesForWords[daTableLength]];
DAs _ DESCRIPTOR
  [lsD.SwapInStateSegment[stateHeader.imageDATableSeg], daTableLength];
diskrequest _ DiskDefs.DiskRequest [
  ca: DataSegmentAddress[scratchSeg],
  fixedCA: TRUE,
  da: @DAs[0],
  fp: @imageFile.fp,
  firstPage: 0,
  lastPage: imageFileLength,
  action: ReadD,
  lastAction: ReadD,
  signalCheckError: FALSE,
  option: update[cleanup: BFSDefs.GetNextDA]];
MiscDefs.SetBlock[@DAs[-1], AltoFileDefs.fillinDA, daTableLength];
DAs[0] _ imageFile.fp.leaderDA;
[] _ BFSDefs.ActOnPages[LOOPHOLE[@diskrequest]];
lsD.WriteStateSegment[stateHeader.imageDATableSeg];
lsD.ReleaseStateSegment[stateHeader.imageDATableSeg];
DeleteDataSegment[scratchSeg];
END;  -- of InitializeState --


InstallState: PROCEDURE
  [imageFile: SegmentDefs.FileHandle, heapDS: SegmentDefs.DataSegmentHandle] =
BEGIN
OPEN SegmentDefs;
profileFP: AltoFileDefs.FP _
  Core.LookupInFileCache[IF profileInUserCm THEN "User.cm"L ELSE "Laurel.profile"L];
profileFile: FileHandle _ IF profileFP = AltoFileDefs.NullFP THEN NIL
  ELSE InsertFile[@profileFP, DefaultAccess];
fontsWidthsFP: AltoFileDefs.FP _ Core.LookupInFileCache["Fonts.widths"L];
fontsWidthsFile: FileHandle _ IF fontsWidthsFP = AltoFileDefs.NullFP THEN NIL
  ELSE InsertFile[@fontsWidthsFP, DefaultAccess];
lowestHeapPage: PageNumber = PageFromAddress[heapFirstFree + 1];
heapPages: PageCount = heapDS.pages - (lowestHeapPage - heapDS.VMpage);
heapFS: FileSegmentHandle;

ShrinkHeap: PROCEDURE =
  BEGIN
  IF lowestHeapPage = heapDS.VMpage THEN RETURN;
  SwapperOps.Update
    [heapDS.VMpage, lowestHeapPage - heapDS.VMpage, SwapperOps.FreePage, FALSE];
  heapDS.VMpage _ lowestHeapPage;
  heapDS.pages _ heapPages;
  END;  -- of ShrinkHeap --

stateHeader.profileFP _ profileFP;
IF profileFile # NIL THEN
  BEGIN
  stateHeader.profileTime _ lsD.GetWrittenTime[profileFile];
  stateHeader.profileInUserCm _ profileInUserCm;
  END;
stateHeader.fontsWidthsFP _ fontsWidthsFP;
IF fontsWidthsFile # NIL THEN
  stateHeader.fontsWidthsTime _ lsD.GetWrittenTime[fontsWidthsFile];
Inline.COPY[to: stateHeader + stateHeader.intCOffset,
  from: @LOOPHOLE[intC, ControlDefs.GlobalFrameHandle].global[0],
  nwords: stateHeader.disCOffset - stateHeader.intCOffset];
Inline.COPY[to: stateHeader + stateHeader.disCOffset,
  from: @LOOPHOLE[disC, ControlDefs.GlobalFrameHandle].global[0],
  nwords: stateHeader.headerFF-stateHeader.disCOffset];
ShrinkHeap[];
lsD.InstallSegments[stateHeader];
stateHeader.heapSegFirstPage _ GetEndOfFile[stateFH].page+1;
stateHeader.heapSegPages _ heapPages;
SetEndOfFile[stateFH, stateHeader.heapSegFirstPage+heapPages-1, AltoDefs.BytesPerPage];
heapFS _ NewFileSegment
  [stateFH, stateHeader.heapSegFirstPage, stateHeader.heapSegPages, Read + Write];
CopyDataToFileSegment[heapDS, heapFS];    -- writes heap to state file
stateHeader.heapSegDA _ GetFileSegmentDA[heapFS];
DeleteFileSegment[heapFS];
stateHeaderSeg.write _ TRUE;
Unlock[stateHeaderSeg];
DeleteFileSegment[stateHeaderSeg];
END;  -- of InstallState --


AllocateStateNode: PUBLIC PROCEDURE[size: CARDINAL] RETURNS [base: POINTER] =
BEGIN
base _ heapFirstFree-size+1;
IF LOOPHOLE[base, CARDINAL] < LOOPHOLE[heapLimit, CARDINAL] THEN
  exD.SysBug[];
heapFirstFree _ base-1;
END;  -- of AllocateStateNode --


AllocateStateString: PUBLIC PROCEDURE [chars: CARDINAL] RETURNS [p: STRING] =
BEGIN
p _ AllocateStateNode[StringDefs.WordsForString[chars]];
p^ _ StringBody[length: 0, maxlength: chars, text: ];
END;  -- of AllocateStateString --


BuildInteractor: PROCEDURE =
-- establishes static structures for interactor
BEGIN
InstallFont[];
inD.BuildScreenStructures[];
disC.bitMapReady _ FALSE;
intC.composedMessageEdited _ FALSE;
intC.timeMayBeBogus _ FALSE;
intC.currentCommand _ NIL;
intC.commandType _ noCommand;
intC.editorMenuState _ singleLine;
intC.target _ intC.source _ inD.TextSelection[mnp: intC.cmTextNbr, start: 0, end: 0,
  point: 0, key: 0, mode: char, pendingDelete: FALSE];
intC.actionPoint _ 0;
intC.currentSelection _ target;
intC.commandMode _ TRUE;
intC.runCommandMode _ FALSE;
intC.secondarySelectionEnabled _ FALSE;
intC.deliverCommandVisible _ TRUE;
END;  -- of BuildInteractor --


InstallFont: PROCEDURE =
-- Assumes 'font' points to the font.  Sets the charPropTable to describe the font, assuming
--   the smudges have already been installed.
BEGIN
ch: CHARACTER;
i: CARDINAL;
whiteString: STRING = " 	
"L;
punctuationString: STRING = "!@#$%~&*()-`=+[{]};:'"",.<>/?\|_^"L;

FOR ch IN dsD.LegalCharacters DO
  disC.charPropertyTable[ch] _ alphaNumeric;
  ENDLOOP;

disC.charPropertyTable[140C] _ punctuation;

FOR i IN [0 .. whiteString.length) DO
  disC.charPropertyTable[whiteString[i]] _ white;
  ENDLOOP;
disC.charPropertyTable[Ascii.TAB + (ovD.LineBreakValue - 0C)] _ white;
disC.charPropertyTable[Ascii.CR + (ovD.LineBreakValue - 0C)] _ white;
FOR i IN [0 .. punctuationString.length) DO
  disC.charPropertyTable[punctuationString[i]] _ punctuation;
  ENDLOOP;
END;  -- of InstallFont --


ReadLaurelProfile: PROCEDURE RETURNS [installError: drD.InstallError] =
-- Opens Laurel.Profile, parses it, and extracts information for intCommon.
BEGIN OPEN StringDefs;
keyWord: STRING _ [50];
value: STRING _ [100];
laurelProfileHandle: csD.StreamHandle;
pH: MailParseDefs.ParseHandle;
start: csD.Position _ 0;
eof: csD.Position;
offEnd: CARDINAL;
crSeen: BOOLEAN;

-- A LARGE number of local procedures for ReadLaurelProfile follow --

ProcessUserCm: PROCEDURE [section: STRING, proc: PROCEDURE]
  RETURNS[found: BOOLEAN] =
  BEGIN

  AdvancePastCR: PROCEDURE RETURNS [BOOLEAN] =
    BEGIN
    DO
      IF csD.Read[laurelProfileHandle ! csD.EndOfStream => EXIT] = Ascii.CR THEN
        RETURN[TRUE];
      ENDLOOP;
    RETURN[FALSE]
    END;  -- of AdvancePastCR --

  found _ TRUE;
  laurelProfileHandle _ csD.OpenFromName["User.cm"L, byte, read
    ! VMDefs.CantOpen => {found _ FALSE; CONTINUE}];
  IF ~found THEN RETURN;
  found _ FALSE;
  BEGIN
  ENABLE UNWIND => csD.Close[laurelProfileHandle];
  DO
    SELECT csD.Read[laurelProfileHandle ! csD.EndOfStream => GO TO Done] FROM
      '[ =>
        BEGIN
        sectionHeading: STRING _ [9];
        sectionHeading.length _ csD.ReadBlock[laurelProfileHandle, @sectionHeading.text,
                              0, section.length];
        IF sectionHeading.length ~= section.length THEN GO TO Done;  -- eof
        IF EquivalentString[sectionHeading, section] THEN EXIT;
        csD.SetPosition[laurelProfileHandle, csD.GetPosition[laurelProfileHandle] -
                           section.length];
        END;
      Ascii.CR => LOOP;
      ENDCASE;
    IF ~AdvancePastCR[] THEN GO TO Done;    -- section not found
    ENDLOOP;
  -- [section] found; scan past CR
  IF ~AdvancePastCR[] THEN GO TO Done;    -- malformed user.cm; ignore it.
  found _ TRUE;
  start _ csD.GetPosition[laurelProfileHandle];
  eof _ csD.GetLength[laurelProfileHandle];
  DO
    SELECT csD.Read[laurelProfileHandle ! csD.EndOfStream => EXIT] FROM
      '[ => {eof _ csD.GetPosition[laurelProfileHandle] - 1; EXIT};
      Ascii.CR => NULL;
      ENDCASE => IF ~AdvancePastCR[] THEN EXIT;
    ENDLOOP;
  csD.SetPosition[laurelProfileHandle, start];
  FOR i: csD.Position IN [start..eof) DO
    IF csD.Read[laurelProfileHandle] ~= Ascii.CR THEN
      {csD.SetPosition[laurelProfileHandle, i]; EXIT};
    ENDLOOP;
  proc[];
  END;  -- ENABLE --
  GO TO Done;
  EXITS
    Done => csD.Close[laurelProfileHandle];
  END;  -- of ProcessUserCm --

ProcessLaurelProfile: PROCEDURE RETURNS [found: BOOLEAN] =
  BEGIN
  found _ TRUE;
  laurelProfileHandle _ csD.OpenFromName["Laurel.Profile"L, byte, read
    ! VMDefs.CantOpen => {found _ FALSE; CONTINUE}];
  IF ~found THEN RETURN;
  BEGIN
  ENABLE UNWIND => csD.Close[laurelProfileHandle];
  start _ 0;
  eof _ csD.GetLength[laurelProfileHandle];
  FOR i: csD.Position IN [start..eof) DO
    IF csD.Read[laurelProfileHandle] ~= Ascii.CR THEN
      {csD.SetPosition[laurelProfileHandle, i]; EXIT};
    ENDLOOP;
  DoLaurelPart[];
  END;  -- ENABLE --
  csD.Close[laurelProfileHandle];
  END;  -- of ProcessLaurelProfile --

InitParse: PROCEDURE =
  BEGIN
  offEnd _ 0;
  crSeen _ FALSE;
  pH _ MailParseDefs.InitializeParse[GetProfileChar];
  END;  -- of InitParse --

GetProfileChar: PROCEDURE RETURNS [char: CHARACTER] =
  BEGIN
  OPEN Ascii;
  inBravoTrailer: BOOLEAN _ FALSE;
  DO
    IF offEnd > 0 OR csD.GetPosition[laurelProfileHandle] >= eof THEN GO TO noChar;
    IF (char _ csD.Read[laurelProfileHandle]) ~= CR THEN
      BEGIN
      IF ~inBravoTrailer THEN
        IF char  = ControlZ THEN inBravoTrailer _ TRUE ELSE EXIT;
      END
    ELSE IF ~crSeen THEN EXIT;
    REPEAT
    noChar => {char _ CR; offEnd _ offEnd + 1};
    ENDLOOP;
  crSeen _ char = CR;
  END;  -- of GetProfileChar --

WriteStringToLog: PROCEDURE [s: STRING] =
  BEGIN
  IF log = NIL THEN InitLog[];
  csD.WriteBlock[log, @s.text, 0, s.length];
  END;  -- of WriteStringToLog --

WriteCharToLog: PROCEDURE [char: CHARACTER] =
  BEGIN
  IF log = NIL THEN InitLog[];
  csD.Write[log, char];
  END;  -- of WriteCharToLog --

WriteLogEntry: PROCEDURE [s: STRING] =
  BEGIN
  WriteStringToLog[s];
  WriteStringToLog["

"L];
  END;  -- of WriteLogEntry --

FinishLogEntry: PROCEDURE = {WriteLogEntry[""L]};

WriteBadValueMsgInLog: PROCEDURE [fieldName: STRING] =
  BEGIN
  WriteStringToLog["The '"L];
  WriteStringToLog[fieldName];
  WriteLogEntry["' entry in the profile is specified incorrectly."L];
  END; -- WriteBadValueMsgInLog --

InitLog: PROCEDURE =
  BEGIN
  preamble: STRING = "*start*
00000 00024 UU 
Date: "L;
  postamble: STRING = "
Subject: Installation Difficulties
From: Laurel

Laurel discovered the following problem(s) during installation:

"L;
  dateString: STRING _ [DMSTimeDefs.timeStringLength];
  log _ csD.OpenFromName["InstallErrors.mail"L, byte, append];
  logStartPosition _ csD.GetPosition[log];
  csD.WriteBlock[log, @preamble.text, 0, preamble.length];
  DMSTimeDefs.MapPackedTimeToTimeZoneString
    [LOOPHOLE[TimeDefs.CurrentDayTime[]], dateString, arpaMsg];
  WriteStringToLog[dateString];
  WriteStringToLog[postamble];
  installError _ inLog;
  END;  -- of InitLog --

FinishLog: PROCEDURE =
  BEGIN
  IF installError ~= none THEN
    BEGIN
    s: STRING _ [5];
    csD.SetPosition[log, logStartPosition + 8];
    AppendDecimal[s, Inline.LowHalf[csD.GetLength[log] - logStartPosition]];
    THROUGH [0 .. 5 - s.length) DO WriteCharToLog['0] ENDLOOP;
    WriteStringToLog[s];
    csD.Close[log];
    END;
  END;  -- of FinishLog --

DoLaurelPart: PROCEDURE =
  BEGIN
  DO
    IF ~MailParseDefs.GetFieldName[pH, keyWord] THEN EXIT;
    BEGIN  -- for EXITS --
    FOR i: CARDINAL IN [0 .. nStringOptions) DO
      IF EquivalentString[keyWord, stringOptions[i].key] THEN
        {FillFromProfile[stringOptions[i].stringP]; GO TO found};
      ENDLOOP;
    FOR i: CARDINAL IN [0 .. nPreValueSpecialOptions) DO
      IF EquivalentString[keyWord, preValueSpecialOptions[i].key] THEN
        {preValueSpecialOptions[i].proc[]; GO TO found};
      ENDLOOP;
    MailParseDefs.GetFieldBody[pH, value];
    FOR i: CARDINAL IN [0 .. nDecommissionedOptions) DO
      IF EquivalentString[keyWord, decommissionedOptions[i]] THEN
        {WriteStringToLog["The profile field '"L]; WriteStringToLog[keyWord];
         WriteLogEntry["' is no longer used."L]; GO TO found};
      ENDLOOP;
    FOR i: CARDINAL IN [0 .. nBooleanOptions) DO
      IF EquivalentString[keyWord, booleanOptions[i].key] THEN
        {booleanOptions[i].boolP^ _ EquivalentString[value, "TRUE"L]
          OR EquivalentString[value, "Yes"L]; GO TO found};
      ENDLOOP;
    FOR i: CARDINAL IN [0 .. nTicksOptions) DO
      IF EquivalentString[keyWord, ticksOptions[i].key] THEN
        {ticksOptions[i].cardP^ _ (StringToDecimal
           [value ! InvalidNumber => {ReportInvalidNumber[]; CONTINUE}] + 37) / 38;
        GO TO found};
      ENDLOOP;
    FOR i: CARDINAL IN [0 .. nFieldOptions) DO
      IF EquivalentString[keyWord, fieldOptions[i].key] THEN
        {fieldOptions[i].cardP^ _ inD.leftMargin + StringToDecimal
           [value ! InvalidNumber => {ReportInvalidNumber[]; CONTINUE}];
        GO TO found};
      ENDLOOP;
    FOR i: CARDINAL IN [0 .. nPostValueSpecialOptions) DO
      IF EquivalentString[keyWord, postValueSpecialOptions[i].key] THEN
        {postValueSpecialOptions[i].proc[]; GO TO found};
      ENDLOOP;
    WriteCharToLog['']; WriteStringToLog[keyWord];
    WriteLogEntry["' in the profile is unrecognizable."L];
    EXITS
    found => NULL;
    END;
    ENDLOOP;
  END;  -- of DoLaurelPart --

DoHardcopyPart: PROCEDURE =
  BEGIN
  discard: STRING _ [0];
  DO
    IF ~MailParseDefs.GetFieldName[pH, keyWord] THEN EXIT;
    SELECT TRUE FROM
      EquivalentString[keyWord, "Press"L] => FillFromProfile[@intC.hardcopyHost];
      EquivalentString[keyWord, "PrintedBy"L] =>
        FillFromProfile[@intC.hardcopyUserName];
      ENDCASE => MailParseDefs.GetFieldBody[pH, discard];
    ENDLOOP;
  END;  -- of DoHardcopyPart --

FillFromProfile: PROCEDURE [s: POINTER TO STRING] =
  BEGIN
  MailParseDefs.GetFieldBody[pH, value];
  FillProfileString[s, value];
  END;  -- of FillFromProfile --

FillProfileString: PROCEDURE [s: POINTER TO STRING, value: STRING] =
  BEGIN
  IF s^ # NIL THEN RETURN;
  s^ _ AllocateStateString[value.length];
  s^.length _ 0;
  StringDefs.AppendString[s^, value];
  END; -- of FillProfileString --

ProcessFontError: PROCEDURE [code: LaurelHardcopyDefs.FontCode] =
  BEGIN
  SELECT code FROM
    profileBadFont =>  -- ParseFont only
      BEGIN
      WriteStringToLog["The profile Font entry '"L]; WriteStringToLog[value];
      WriteLogEntry["' does not contain a valid font number."L];
      END;
    badFontsWidths =>
      WriteLogEntry["The file 'Fonts.Widths' is missing or unreadable."L];
    fontNotInFontsWidths =>
      BEGIN
      IF value.length = 0 THEN WriteStringToLog["A default font"L]
      ELSE {WriteCharToLog['']; WriteStringToLog[value]; WriteCharToLog['']};
      WriteLogEntry[" is not in Fonts.Widths."L];
      END;
    ENDCASE => exD.SysBug[];
  intC.hardcopyInstallError _ TRUE;
  END; -- of ProcessFontError --

FontProc: PROCEDURE =
  BEGIN
  MailParseDefs.GetFieldBody[pH, value, TRUE];
  LaurelHardcopyDefs.ParseFont[value
    ! LaurelHardcopyDefs.FontError => {ProcessFontError[code]; CONTINUE}];
  END;  -- of FontProc --

HardcopyFormProc: PROCEDURE = {LaurelHardcopyDefs.ParseHardcopyForm[pH]};

BoundaryProc: PROCEDURE =
  BEGIN
  bad: BOOLEAN _ FALSE;
  item: {command, toc, dm, cm, bad} _ command;
  keyNo: CARDINAL;

  ProcessOne: PROC [n, r: STRING, isFile, nested: BOOLEAN]
    RETURNS [BOOLEAN] =
    BEGIN
    val: CARDINAL;
    IF n.length = 0 OR r.length # 0 OR nested THEN GO TO bogus;
    val _ StringToDecimal[n ! InvalidNumber => GO TO bogus];
    SELECT item FROM
      command => IF (keyNo _ val) ~IN [0 .. 9] THEN GO TO bogus;
      toc => intC.boundarySet[keyNo].toc _ val;
      dm => intC.boundarySet[keyNo].dm _ val;
      cm => intC.boundarySet[keyNo].cm _ val;
      ENDCASE => GO TO bogus;
    item _ SUCC[item];
    RETURN[FALSE];
    EXITS
    bogus => {bad _ TRUE; RETURN[FALSE]};
    END;  -- of ProcessOne --

  MailParseDefs.ParseNameList[ph: pH, process: ProcessOne];
  IF bad THEN WriteBadValueMsgInLog[keyWord];
  END;  -- of BoundaryProc --

ReportInvalidNumber: PROCEDURE =
  BEGIN
  WriteStringToLog[value];  WriteStringToLog[" in "L];  WriteStringToLog[keyWord];
  WriteLogEntry[" profile entry is an invalid number."L];
  END;  -- ReportInvalidNumber --

Ignore: PROCEDURE = {};

SetPoll: PROCEDURE =
  BEGIN
  pollingInterval: CARDINAL _ 300;
  pollingInterval _ StringToDecimal
    [value ! InvalidNumber => {ReportInvalidNumber[]; CONTINUE}];
  intC.mailcheckPollingInterval
    _ IF pollingInterval = 0 THEN 15 ELSE ((pollingInterval + 14) / 15) * 15;
  -- polling interval will be a multiple of 15 seconds and greater than 0.
  END;  -- of SetPoll --

SetBackground: PROCEDURE =
  BEGIN
  SELECT TRUE FROM
    EquivalentString[value, "white"L] => videoBackground _ white;
    EquivalentString[value, "black"L] => videoBackground _ black;
    ENDCASE => WriteBadValueMsgInLog[keyWord];
  END;  -- of SetBackground --

SetSendMode: PROCEDURE =
  BEGIN
  SELECT TRUE FROM
    EquivalentString[value, "mtp"L] => intC.profileSendMode _ mtp;
    EquivalentString[value, "gv"L] => intC.profileSendMode _ gv;
    EquivalentString[value, "auto"L] => intC.profileSendMode _ auto;
    ENDCASE => WriteBadValueMsgInLog[keyWord];
  END;  -- of SetSendMode --

SetCForCopies: PROCEDURE = {intC.cForCopies _ EquivalentString[value, "c"L]};

SetEditorType: PROCEDURE =
  {IF EquivalentString[value, "modeless"L] THEN intC.editorType _ modeless};

SetCopies: PROCEDURE =
  BEGIN
  n: CARDINAL _ 0;
  n _ StringToDecimal[value ! InvalidNumber => {ReportInvalidNumber[]; CONTINUE}];
  IF n IN [1 .. 99] THEN intC.defaultHardCopies _ n;
  END;  -- of SetCopies --

SetControlRed: PROCEDURE =
  {intC.controlRedEnabled _ ~EquivalentString[value, "TRUE"L]};

SetExceptionType: PROCEDURE =
  {IF EquivalentString[value, "LaurelX"L] THEN intC.exceptionType _ LaurelX};

SetDisplayLines: PROCEDURE =
  BEGIN
  max: CARDINAL = AltoDisplay.MaxScanLines / dsD.lineHeight;
  min: CARDINAL = max/2;
  n: CARDINAL _ 0;
  n _ StringToDecimal[value ! InvalidNumber => {ReportInvalidNumber[]; CONTINUE}];
  IF n IN [min .. max] THEN intC.numScanLines _ n * dsD.lineHeight;
  END;  -- of SetCopies --


ProfileStringRecord: TYPE = RECORD [key: STRING, stringP: POINTER TO STRING];
ProfileBooleanRecord: TYPE = RECORD [key: STRING, boolP: POINTER TO BOOLEAN];
ProfileCardinalRecord: TYPE = RECORD [key: STRING, cardP: POINTER TO CARDINAL];
ProfileProcRecord: TYPE = RECORD [key: STRING, proc: PROCEDURE];
nStringOptions: CARDINAL = 14;
nBooleanOptions: CARDINAL = 10;
nTicksOptions: CARDINAL = 6;
nPreValueSpecialOptions: CARDINAL = 3;
nPostValueSpecialOptions: CARDINAL = 11;
nDecommissionedOptions: CARDINAL = 8;
nFieldOptions: CARDINAL = 3;
stringOptions: ARRAY [0 .. nStringOptions) OF ProfileStringRecord _
  [["Registry"L, @intC.profileRegistry],
  ["Send"L, @intC.profileSend],
  ["Retrieve"L, @intC.profileRetrieve],
  ["Printer"L, @intC.hardcopyHost],
  ["Hardcopy"L, @intC.hardcopyHost],
  ["PrintedBy"L, @intC.hardcopyUserName],
  ["LaurelSupport"L, @intC.bugReportee],
  ["RunPath"L, @intC.runPath],
  ["RemoteFilePath"L, @intC.remoteFilePath],
  ["ChollaArchive"L, @intC.chollaArchiveFilePath],
  ["DefaultHardcopyForm"L, @intC.defaultHardcopyFormName],
  ["NewMailTune"L, @intC.newMailTune],
  ["Workstation"L, @intC.workstationName],
  ["ChollaDL"L, @intC.chollaDL]];
preValueSpecialOptions: ARRAY [0 .. nPreValueSpecialOptions) OF ProfileProcRecord _
  [["Font"L, FontProc],
  ["HardcopyForm"L, HardcopyFormProc],
  ["Boundary"L, BoundaryProc]];
decommissionedOptions: ARRAY [0 .. nDecommissionedOptions) OF STRING _
  ["Authenticate"L,
  "ForceMTPSend"L,
  "Herald"L,
  "HeraldFont"L,
  "Logo"L,
  "LogoFont"L,
  "Poll"L,
  "DisplayErrorPups"L];
booleanOptions: ARRAY [0 .. nBooleanOptions) OF ProfileBooleanRecord _
  [["Leaf"L, @intC.leafOk],
  ["Cholla"L, @intC.isCholla],
  ["GVTestingMode"L, @intC.gvTestingMode],
  ["NewFormAfterDelivery"L, @intC.newFormAfterDelivery],
  ["DisplayAfterDelete"L, @intC.displayAfterDelete],
  ["TwoSided"L, @intC.twoSidedPrintingDefault],
  ["Private"L, @intC.passwordPrintingDefault],
  ["WriteProtected"L, @intC.disableWriting],
  ["BluePendingDelete"L, @intC.bluePendingDelete],
  ["DeliverWithCRs"L, @intC.deliverWithCR]];
ticksOptions: ARRAY [0 .. nTicksOptions) OF ProfileCardinalRecord _
  [["Click"L, @intC.multiClickTimeOut],
  ["Tap"L, @intC.tapTimeOut],
  ["ScrollTimeOut"L, @intC.continuousScrollTimeOut],
  ["ScrollDelay"L, @intC.continuousScrollDelay],
  ["BracketTimeOut"L, @intC.nextBracketTimeout],
  ["BracketDelay"L, @intC.nextBracketDelay]];
fieldOptions: ARRAY [0 .. nFieldOptions) OF ProfileCardinalRecord _
  [["FromField"L, @intC.fromRightX],
  ["SubjectField"L, @intC.subjectLeftX],
  ["SubjectFieldExtension"L, @intC.subjectExtensionLeftX]];
postValueSpecialOptions: ARRAY [0 .. nPostValueSpecialOptions) OF ProfileProcRecord _
  [["Comment"L, Ignore],
  ["C"L, Ignore],
  ["DendroicaStriata"L, SetPoll],
  ["Background"L, SetBackground],
  ["SendMode"L, SetSendMode],
  ["CopiesField"L, SetCForCopies],
  ["Editor"L, SetEditorType],
  ["Copies"L, SetCopies],
  ["HomoTollens"L, SetControlRed],
  ["ErrorKeys"L, SetExceptionType],
  ["DisplayLines"L, SetDisplayLines]];

-- Main body of ReadLaurelProfile follows --

installError _ none;

-- initialize defaultable fields --

FOR i: CARDINAL IN [0 .. nStringOptions) DO
  stringOptions[i].stringP^ _ NIL;
  ENDLOOP;
FOR i: CARDINAL IN [0 .. nBooleanOptions) DO
  booleanOptions[i].boolP^ _ FALSE;
  ENDLOOP;
intC.autoConfirm _ FALSE;
intC.profileSendMode _ auto;
intC.profileRetrieveMode _ auto;
intC.mailcheckPollingInterval _ 300;
intC.multiClickTimeOut _ 10;
intC.tapTimeOut _ 10;
intC.continuousScrollTimeOut _ 26;
intC.continuousScrollDelay _ 5;
intC.nextBracketTimeout _ 19;
intC.nextBracketDelay _ 19;
intC.dateLeftX _ inD.leftMargin + 50;
intC.dateRightX _ inD.leftMargin + 100;
intC.fromLeftX _ inD.leftMargin + 110;
intC.fromRightX _ inD.leftMargin + 250;
intC.subjectLeftX _ inD.leftMargin + 260;
intC.subjectExtensionLeftX _ inD.leftMargin + 275;
videoBackground _ white;
intC.cForCopies _ FALSE;
intC.controlRedEnabled _ TRUE;
intC.pendingDeleteSetByControl _ FALSE;
intC.audioEnabled _ FALSE;
intC.hardcopyInstallError _ FALSE;
intC.editorType _ modal;
intC.defaultHardCopies _ 1;
intC.exceptionType _ Laurel;
intC.boundarySet _ lsD.AllocateStateNode[SIZE[inD.BoundarySetArray]];
intC.boundarySet^ _ ALL[[toc: 12, dm: 19, cm: 16]];
intC.boundarySet[1] _ [toc: 1, dm: 0, cm: 0];
intC.boundarySet[2] _ [toc: 0, dm: 1, cm: 0];
intC.boundarySet[3] _ [toc: 0, dm: 0, cm: 1];
intC.numScanLines _ 720; -- 60 text lines of 12 scan lines each

-- acquire profile information
LaurelHardcopyDefs.InitHardcopyFonts[];
InitParse[];
profileInUserCm _ FALSE;
BEGIN
ENABLE MailParseDefs.ParseError =>
  BEGIN
  context: CARDINAL = 20;
  s: STRING _ [context];
  position: csD.Position _ csD.GetPosition[laurelProfileHandle];
  WriteStringToLog["Syntax error in profile near:  '"L];
  position _ IF position < start + context THEN start ELSE position - context;
  csD.SetPosition[laurelProfileHandle, position];
  s.length _ csD.ReadBlock[laurelProfileHandle, @s.text, 0, context];
  WriteStringToLog[s]; WriteCharToLog['']; FinishLogEntry[];
  CONTINUE
  END;
IF ~ProcessLaurelProfile[] THEN
  BEGIN
  profileInUserCm _ ProcessUserCm[section: "Laurel]"L, proc: DoLaurelPart];
  IF profileInUserCm AND installError = none THEN
    BEGIN
    MailParseDefs.FinalizeParse[pH];
    InitParse[];
    [] _ ProcessUserCm[section: "Hardcopy]"L, proc: DoHardcopyPart];
    END;
  END;

END;  -- of ENABLE --

MailParseDefs.FinalizeParse[pH];

IF Storage.StringLength[intC.profileRegistry] = 0 THEN
  WriteLogEntry["No 'Registry' field in profile."L]
ELSE IF intC.profileRegistry.length > 40 THEN
  WriteLogEntry["Registry name is too long."L];
IF intC.isCholla _ (intC.isCholla AND FrameDefs.IsBound[ccD.ChollaMailProcess]) THEN
  BEGIN
  IF intC.chollaArchiveFilePath = NIL THEN
      WriteLogEntry["No ChollaArchive field in profile."L];
  IF intC.workstationName = NIL THEN WriteLogEntry["No Workstation field in profile."L];
  IF intC.chollaDL = NIL THEN WriteLogEntry["No ChollaDL field in profile."L];
  END;

-- provide defaults (overwrites only if string is still NIL)

FillProfileString[@intC.profileRegistry, "NoRegistry"L];
FillProfileString[@intC.workstationName, "NoName"L];
FillProfileString[@intC.hardcopyHost, ""L];
FillProfileString[@intC.hardcopyUserName, "$"L];
FillProfileString[@intC.defaultHardcopyFormName, "Blank"L];
IF intC.hardcopyUserName[0] = '" AND
  intC.hardcopyUserName[intC.hardcopyUserName.length-1] = '" THEN
  BEGIN
  i: CARDINAL;
  FOR i IN [0 .. intC.hardcopyUserName.length - 2) DO
    intC.hardcopyUserName[i] _ intC.hardcopyUserName[i + 1];
    ENDLOOP;
  intC.hardcopyUserName.length _ intC.hardcopyUserName.length - 2;
  END;
intC.passwordPrinting _ intC.passwordPrintingDefault;
intC.twoSidedPrinting _ intC.twoSidedPrintingDefault;
intC.hardCopies _ intC.defaultHardCopies;

FillProfileString[@intC.bugReportee, "LaurelSupport.PA"L];

value.length _ 0;
LaurelHardcopyDefs.InstallHardcopy[
  ! LaurelHardcopyDefs.FontError => {ProcessFontError[code]; CONTINUE}];
FinishLog[];
END;  -- of ReadLaurelProfile --


GetImageFileName: PROCEDURE =
BEGIN
OPEN SegmentDefs;
file: FileHandle = FrameOps.CodeHandle[FrameDefs.GlobalFrame[intC]].file;
seg: FileSegmentHandle _ NewFileSegment[file, 0, 1, Read];
leader: POINTER TO AltoFileDefs.LD;
SwapIn[seg];
leader _ FileSegmentAddress[seg];
intC.imageFileName _ lsD.AllocateStateString
          [LOOPHOLE[@leader.name, POINTER TO StringDefs.BcplSTRING].length];
StringDefs.BcplToMesaString[LOOPHOLE[@leader.name], intC.imageFileName];
intC.imageFileName.length _ intC.imageFileName.length - 1; -- get rid of dot. --
Unlock[seg];
DeleteFileSegment[seg];
END;  -- of GetImageFileName --


CreateLaurelState: PUBLIC PROCEDURE[heapDS: SegmentDefs.DataSegmentHandle]
  RETURNS [installError: drD.InstallError] =
BEGIN
savedCursor: dsD.CursorBitMap;
installCursor: dsD.CursorBitMap =
  [002000B, 001000B, 000400B, 001000B, 002000B, 007600B, 037740B, 177777B,
   147631B, 140031B, 142031B, 142037B, 143430B, 160070B, 077760B, 017700B];
imageFile: SegmentDefs.FileHandle = FrameOps.CodeHandle[FrameDefs.GlobalFrame[intC]].file;
savedCursor _ dsD.cursorBM^;
dsD.cursorBM^ _ installCursor;
InitializeState[imageFile, heapDS];
IF (installError _ ReadLaurelProfile[]) ~= none THEN
  BEGIN
  -- ensure that state will be recomputed next time.  This guarantees that the user
  -- cannot use Laurel until the profile problem is fixed.  If this code is removed,
  -- Laurel will install the defaults in the state and use them until the user edits
  -- user.cm or laurel.profile.
  Core.FreeCacheEntry["Laurel.profile"L];
  profileInUserCm _ FALSE;
  END;
BuildInteractor[];
GetImageFileName[];
InstallState[imageFile, heapDS];
dsD.cursorBM^ _ savedCursor;
END; -- of CreateLaurelState --


END.  -- of InstallLaurel --