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