// 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
//---------------------------------------------------------------------------