// IfsCmdScan.bcpl -- IFS version of Command Scanner Package, main module
// Copyright Xerox Corporation 1979, 1980

// Last modified by Taft, February 28, 1980  3:31 PM
// Last modified by Butterfield, October 19, 1979  2:01 PM
// - EnableCatch, make it work for extended calls - 10/17/79

// Derived from: CmdScan.bcpl -- Command Scanner Package, main module
// Last modified July 13, 1977  5:47 PM

get "CmdScan.decl"
get "IfsXEmulator.decl"

external
[
//outgoing procedures
InitCmd; ErasePhrase; BackupPhrase
DefaultPhrase; BeginDefaultPhrase; EndDefaultPhrase
EnableCatch; DisableCatch; EndCatch
CurrentPhrase; NextPhrase; TerminatingChar; CmdErrorCode

//for OEP declaration only
CSGets; CSPuts; CSEndofs; CSCloses; CSResets

//incoming procedures
DefErase; DefError; DefBreak; DefEcho; AppendChar; EraseInput
Gets; Puts; Errors; Wss; Closes
DefaultArgs; Allocate; Free; Zero
CallersFrame; GotoLabel

//incoming statics
sysZone; keys; dsp
]


//---------------------------------------------------------------------------
let InitCmd(maxChars, maxPhrases, WordBreak, PhraseTerminator,
     Echo, keyS, dspS, Erase, Error, zone; numargs na) = valof
//---------------------------------------------------------------------------
//Creates and initializes a Command State (cs) structure.
//Required arguments are maxChars, the maximum number of characters
//permitted in the command (including noise words), and maxPhrases,
//the maximum number of phrases.  WordBreak, PhraseTerminator, and
//Echo are the default word break, phrase terminator, and echo
//predicates for the command (they may be overridden on a
//per-phrase basis).  keyS and dspS are the input and output
//streams for the command scanner.  Erase is a procedure for
//erasing characters from the display.  Error is the Errors
//procedure for the command stream.
//returns a pointer to the CS structure.
[
DefaultArgs(lv na, -2, DefBreak, DefBreak, DefEcho,
 keys, dsp, DefErase, DefError, sysZone)
let cs = Allocate(zone, lenCS+maxPhrases*lenPD)
Zero(cs, lenCS)
cs>>CS.buf = Allocate(zone, maxChars rshift 1 +1)
cs>>CS.maxChars = maxChars
cs>>CS.maxPhrases = maxPhrases
cs>>CS.pd↑0.WordBreak = WordBreak
cs>>CS.pd↑0.PhraseTerminator = PhraseTerminator
cs>>CS.pd↑0.Echo = Echo
cs>>CS.keyS = keyS
cs>>CS.dspS = dspS
cs>>CS.Erase = Erase
cs>>CS.zone = zone
cs>>CS.gets = CSGets
cs>>CS.puts = CSPuts
cs>>CS.endof = CSEndofs
cs>>CS.close = CSCloses
cs>>CS.reset = CSResets
cs>>CS.error = Error
XCatchPC(lv cs>>CS.pd↑0, CallersFrame())
cs>>CS.phraseRead = true  //don't use dummy phrase
cs>>CS.editControl = editNew
resultis cs
]

//---------------------------------------------------------------------------
and CSCloses(cs) be
//---------------------------------------------------------------------------
[
Free(cs>>CS.zone, cs>>CS.buf)
Free(cs>>CS.zone, cs)
]


//---------------------------------------------------------------------------
and CSGets(cs) = valof
//---------------------------------------------------------------------------
//Returns the next character from the current phrase.  Calls Errors if
//the phrase is exhausted.
[
let i = cs>>CS.iChOut
if i ge CurrentPhrase(cs)>>PD.iLast then resultis Errors(cs, ecEndOfPhrase)
cs>>CS.iChOut = i+1
resultis cs>>CS.buf>>Buf↑i & #177
]


//---------------------------------------------------------------------------
and CSEndofs(cs) = cs>>CS.iChOut ge CurrentPhrase(cs)>>PD.iLast
//---------------------------------------------------------------------------
//Returns true if the current phrase is exhausted


//---------------------------------------------------------------------------
and CSPuts(cs, char) be unless cs>>CS.reparse do AppendChar(cs, char, true)
//---------------------------------------------------------------------------
//Outputs char to the stream dspS, and also puts it in the command
//buffer (to facilitate retyping and backspacing over).


//---------------------------------------------------------------------------
and CSResets(cs) be [ cs>>CS.phraseRead = false; cs>>CS.reuse = true ]
//---------------------------------------------------------------------------
//Resets the output pointer to the beginning of the current phrase
//such that the next GetPhrase will return the same phrase as before.

//---------------------------------------------------------------------------
and NextPhrase(cs) = valof
//---------------------------------------------------------------------------
//advances the output pointer to the next unread phrase, unless
//the current phrase hasn't been read yet.
//returns pointer to phrase's PD.
[
if cs>>CS.phraseRead then
   [
   if cs>>CS.iPhOut eq cs>>CS.maxPhrases then Errors(cs, ecTooManyPhrases)
   cs>>CS.iPhOut = cs>>CS.iPhOut+1
   cs>>CS.phraseRead = false
   if cs>>CS.iPhOut gr cs>>CS.iPhIn then
      [  //not rescanning - really create new phrase
      cs>>CS.iPhIn = cs>>CS.iPhOut
      let pd = CurrentPhrase(cs)
      Zero(pd, lenPD)
      pd>>PD.iFirst = cs>>CS.iChIn
      ]
   ]
resultis CurrentPhrase(cs)
]


//---------------------------------------------------------------------------
and DefaultPhrase(cs, string, char; numargs na) be
//---------------------------------------------------------------------------
//Creates a new phrase containing the default value "string",
//and sets the editControl to editReplace.  The string should not
//contain a terminating character.
//The idea is that one then calls GetPhrase to input the phrase
//after giving the user a chance to replace or edit it.
//If char is supplied, it is used as the terminating character and
//the user is not given a chance to edit the phrase.
[
DefaultArgs(lv na, -2, 0)
BeginDefaultPhrase(cs)
Wss(cs, string)
EndDefaultPhrase(cs, char)
]


//---------------------------------------------------------------------------
and BeginDefaultPhrase(cs) be NextPhrase(cs)
//---------------------------------------------------------------------------


//---------------------------------------------------------------------------
and EndDefaultPhrase(cs, char; numargs na) be
//---------------------------------------------------------------------------
   unless cs>>CS.reparse do
      [
      CurrentPhrase(cs)>>PD.iLast = cs>>CS.iChIn
      cs>>CS.editControl = editReplace
      if na gr 1 & char ne 0 then cs>>CS.putbackChar = char
      ]

//---------------------------------------------------------------------------
and EnableCatch(cs) = valof
//---------------------------------------------------------------------------
[
XCatchPC(NextPhrase(cs), CallersFrame())
resultis false
]


//---------------------------------------------------------------------------
and XCatchPC(pd, frame) be
//---------------------------------------------------------------------------
[
pd>>PD.catchFrame = frame
let catchPC = frame!1 + 1;
test catchPC eq lv frame!xJmp  // extended caller?
   ifso
      [
      pd>>PD.catchReturn.xJmp = frame!xJmp
      pd>>PD.catchReturn.xPC = frame!xPC
      ]
   ifnot
      [
      pd>>PD.catchReturn.xJmp = 2401B  // JMP @.+1
      pd>>PD.catchReturn.xPC = catchPC
      ]
]


//---------------------------------------------------------------------------
and DisableCatch(cs) be CurrentPhrase(cs)>>PD.catchFrame = 0
//---------------------------------------------------------------------------


//---------------------------------------------------------------------------
and EndCatch(cs) be
//---------------------------------------------------------------------------
[
if cs>>CS.iPhOut gr cs>>CS.iPhTarget then
   [ cs>>CS.iPhOut = cs>>CS.iPhOut-1; DoBackup(cs) ]
cs>>CS.iChOut = CurrentPhrase(cs)>>PD.iFirst
cs>>CS.phraseRead = cs>>CS.iPhOut eq 0
cs>>CS.errorCode = 0
]

//---------------------------------------------------------------------------
and ErasePhrase(cs, nPh, editControl, char; numargs na) be
//---------------------------------------------------------------------------
//Sends control back nPh phrases relative to CS.iPhOut after
//erasing all intervening phrases.
[
DefaultArgs(lv na, -1, 0, editReplace, 0)
let pd = lv cs>>CS.pd↑(cs>>CS.iPhOut-nPh)
EraseInput(cs, (editControl eq editNew? pd>>PD.iFirst, pd>>PD.iLast),
 eraseWord)
BackupPhrase(cs, nPh, editControl, char)
]


//---------------------------------------------------------------------------
and BackupPhrase(cs, nPh, editControl, char; numargs na) be
//---------------------------------------------------------------------------
//Backs up the command scanner nPh phrases relative to CS.iPhOut,
//and stores editControl into CS.editControl and char into
//CS.putbackChar.
//All intervening enabled catch phrases are executed, including
//the one associated with the target phrase if any.  This procedure
//does not actually erase any characters from the command, it
//merely sends control back to an earlier point of interpretation.
[
DefaultArgs(lv na, -1, 0, editReplace, 0)
cs>>CS.iPhTarget = cs>>CS.iPhOut-nPh
cs>>CS.editControl = editControl
cs>>CS.putbackChar = char
cs>>CS.reparse = true
DoBackup(cs)
]


//---------------------------------------------------------------------------
and DoBackup(cs) be
//---------------------------------------------------------------------------
[
let pd = CurrentPhrase(cs)
let frame = pd>>PD.catchFrame
if frame ne 0 then
   [
   if cs>>CS.iPhOut eq 0 then
      test cs>>CS.destroy
         ifso [ Closes(cs); cs = 0 ]
         ifnot EndCatch(cs)
   GotoLabel(frame, lv pd>>PD.catchReturn, cs)
   ]
cs>>CS.iPhOut = cs>>CS.iPhOut-1
] repeat


//---------------------------------------------------------------------------
and CurrentPhrase(cs) = lv cs>>CS.pd↑(cs>>CS.iPhOut)
//---------------------------------------------------------------------------


//---------------------------------------------------------------------------
and TerminatingChar(cs) =
//---------------------------------------------------------------------------
   cs>>CS.buf>>Buf↑(CurrentPhrase(cs)>>PD.iLast) & #177


//---------------------------------------------------------------------------
and CmdErrorCode(cs) = cs>>CS.errorCode
//---------------------------------------------------------------------------