jp@lanl.ARPA (10/06/85)
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Define -- simple string replacement macro processor }
program Define;
%include swtools
%include defdef
%include defvar
%include defproc
{ InitDef -- initialize variables for define }
procedure InitDef;
begin
CvtSST('define', defName);
bp := 0; { push back buffer pointer }
InitHash
end;
begin
ToolInit;
null[1] := ENDSTR;
InitDef;
Install(defName, null, DEFTYPE);
while (GetTok(token, MAXTOK) <> ENDFILE) do
if (not IsLetter(token[1])) then
PutStr(token, STDOUT)
else if (not Lookup(token, defn, tokType)) then
PutStr(token, STDOUT) { undefined }
else if (tokType = DEFTYPE) then begin { defn }
GetDef(token, MAXTOK, defn, MAXDEF);
Install(token, defn, MACTYPE)
end
else
PBStr(defn) { push back replacement string }
end.
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
program DeskCalculator;
%include swtools
const
maxStackIndex = 500;
maxRegisterIndex = 500;
type
StackIndexType = 0..maxStackIndex;
StackElementType = Real;
RegisterIndexType = 0..maxRegisterIndex;
var
stack: array [StackIndexType] of StackElementType;
stackPointer: StackIndexType;
registers: array [RegisterIndexType] of StackElementType;
%page
procedure StackPush(const val: Real);
begin
if stackPointer < maxStackIndex then begin
stack[stackPointer] := val;
stackPointer := Succ(stackPointer)
end {then}
else
Message('Stack overflow, value ignored');
end; {StackPush}
procedure StackPop(var val: Real);
begin
if stackPointer > Lowest(StackIndexType) then begin
stackPointer := Pred(stackPointer);
val := stack[stackPointer]
end {then}
else begin
Message('Stack Underflow, replaced with zero');
val := 0
end {if};
end; {StackPop}
%page
Procedure PrintHelp;
begin
MPutStr('Desk Calculator HELP:$N$N$N$E', STDOUT);
MPutStr('DeskCalc implements a reverse Polish calculator$N' ||
'(or RPN) similar to a Hewlett Packard Calculator$N$E',
STDOUT);
MPutStr('There are the basic operators as well as a stack of$N' ||
'up to 500 deep and 500 registers for SAVE/READ$N$N$E',
STDOUT);
MPutStr('* Multiply$N$E',STDOUT);
MPutStr('/ Divide$N$E', STDOUT);
MPutStr('+ Plus$N$E', STDOUT);
MPutStr('- Minus$N$E', STDOUT);
MPutStr('% Modulo (integer)$N$E', STDOUT);
MPutStr('_ Unary negate$N$N$E',STDOUT);
MPutStr('Other commands, only first letter significant$N$N$E',
STDOUT);
MPutStr('Print Print top of stack$N$E',STDOUT);
MPutStr('Clear Clear stack$N$E',STDOUT);
MPutStr('Quit Quit$N$E', STDOUT);
MPutStr('Help Help (you''re reading it)$N$E',STDOUT);
MPutStr('Save Save TOS-1 in register TOS,$N$E' ||
' pops TOS-1 and TOS$N$E', STDOUT);
MPutStr('Read Read register TOS into TOS$N$E', STDOUT);
MPutStr('Drop Pop and ignore top of stack$N$E', STDOUT);
MPutStr('Trace If TOS 0, turn off tracing, else on$N$E', STDOUT);
MPutStr('Wap sWap TOS and TOS-1$N$E', STDOUT);
end {PrintHelp};
%page
function Calculate(const arg: StringType):Boolean;
var
val, left, right: StackElementType;
temp: String(MAXSTR);
outVal: StringType;
i,j,k: Integer;
static
traceFlag: Boolean;
value
traceFlag := false;
begin
Calculate := true;
if traceFlag then begin
PutDec(stackPointer, 4);
PutC(BLANK);
PutStr(arg, STDOUT);
PutC(NEWLINE);
end;
if arg[1] in [DIG0..DIG9,PERIOD] then begin
ReadStr(Str(arg), val);
StackPush(val)
end
else begin
case arg[1] of
STAR, MINUS, PLUS, SLASH, PERCENT: begin
StackPop(right);
StackPop(left);
case arg[1] of
STAR:
left := left * right;
MINUS:
left := left - right;
PLUS:
left := left + right;
SLASH:
left := left / right;
PERCENT:
left := Round(left) mod Round(right)
end {case};
StackPush(left)
end; { Dyadic operators }
UNDERLINE: begin
StackPop(left);
StackPush(- left)
end {UNDERLINE (unary negate)};
LETD, BIGD: StackPop(left);
LETC, BIGC: stackPointer :=
Lowest(StackIndexType);
LETH, BIGH: PrintHelp;
LETW, BIGW: begin
StackPop(right);
StackPop(left);
StackPush(right);
StackPush(left);
end {LETW, BIGW};
LETQ, BIGQ: Calculate := false;
LETP, BIGP: begin
StackPop(left);
StackPush(left);
if (left > 1.0e11) or (left < 1.0e-5) then
WriteStr(temp, left:20)
else
WriteStr(temp, left:20:10);
outVal := temp;
outVal[Length(temp) + 1] := ENDSTR;
PutStr(outVal, STDOUT);
PutC(NEWLINE)
end {LETP, BIGP};
LETT, BIGT: begin
StackPop(left);
if left = 0 then
traceFlag := false
else
traceFlag := true
end {LETT, BIGT};
LETR, BIGR: begin
StackPop(right);
j := Round(right);
if (j >= Lowest(RegisterIndexType)) and
(j <= Highest(RegisterIndexType)) then
StackPush(registers[j])
else begin
Message('READ: Bad register number');
StackPush(0.0)
end
end {LETR, BIGR};
LETS, BIGS: begin
StackPop(right);
StackPop(left);
j := Round(right);
if (j >= Lowest(RegisterIndexType)) and
(j <= Highest(RegisterIndexType)) then
registers[j] := left
else
Message('SAVE: Bad register number');
end {LETR, BIGR}
otherwise begin
PutCF(NEWLINE, STDERR);
PutCF(SQUOTE, STDERR);
PutStr(arg, STDERR);
Message('''is illegal input.');
end {otherwise}
end {case}
end {if};
end {Calculate};
%page
var
lin: StringType;
arg: StringType;
lineIndex, nextLineIndex: 0..MAXSTR;
argNumber: Integer;
notDone: Boolean;
begin
ToolInit;
stackPointer := 0;
notDone := true;
if NArgs> 0 then begin
argNumber := 1;
while notDone and GetArg(argNumber, lin, MAXSTR) do begin
/* PutDec(argNumber, 1); PutC(BLANK);
PutStr(lin, STDOUT);
PutC(NEWLINE); */
notDone := Calculate(lin);
argNumber := argNumber + 1
end {while}
end
else begin
MPutStr('Desk Calculator V0.00 (type H for help)$N$E', STDOUT);
while notDone and GetLine(lin, STDIN, MAXSTR) do begin
lineIndex := 1;
nextLineIndex := GetWord(lin, lineIndex, arg);
while notDone and (nextLineIndex > 0) do begin
notDone := Calculate(arg);
lineIndex := nextLineIndex;
nextLineIndex := GetWord(lin, lineIndex, arg)
end {while}
end {while}
end {if}
end.
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoChq -- Change quote characters }
segment DoChq;
%include swtools
%include macdefs
%include macproc
procedure DoChq;
var
temp: StringType;
n: Integer;
begin
CsCopy(evalStk, argStk[i+2], temp);
n := StrLength(temp);
if (n <= 0) then begin
lQuote := GRAVE;
rQuote := ACUTE;
end {elseif}
else if (n = 1) then begin
lQuote := temp[1];
rQuote := lQuote
end {elseif}
else begin
lQuote := temp[1];
rQuote := temp[2]
end {if}
end {DoCkq};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoCmd -- handle all commands except globals }
segment DoCmd;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function DoCmd;
var
fil, sub: StringType;
line3: Integer;
gFlag, pFlag: Boolean;
begin
pFlag := false; { may be set by d, m, s }
status := ERR;
case lin[i] of
PCMD:
if (lin[i+1] = NEWLINE) then
if (Default(curLn, curLn, status) = OK) then
status := DoPrint(line1, line2);
LCMD:
if (lin[i+1] = NEWLINE) then
if (Default(curLn, curLn, status) = OK) then
status := DoLPrint(line1, line2);
NEWLINE: begin
if (nLines = 0) then begin
line2 := nextLn(curLn);
line1 := line2;
end; {if}
status := DoPrint(line1, line2)
end;
QCMD:
if (lin[i+1] = NEWLINE) and (nLines = 0) and (not glob) then
status := ENDDATA;
OCMD:
if (not glob) then
status := DoOption(lin, i);
ACMD:
if (lin[i+1] = NEWLINE) then
status := Append(line2, glob);
CCMD:
if (lin[i+1] = NEWLINE) then
if (Default(curLn, curLn, status) = OK) then
if (LnDelete(line1, line2, status) = OK) then
status := Append(PrevLn(line1), glob);
DCMD:
if (CkP(lin, i+1, pFlag, status) = OK) then
if (Default(curLn, curLn, status) = OK) then
if (LnDelete(line1, line2, status) = OK) then
if (NextLn(curLn) <> 0) then
curLn := NextLn(curLn);
ICMD:
if (lin[i+1] = NEWLINE) then begin
if (line2 = 0) then
status := Append(0, glob)
else
status := Append(PrevLn(line2), glob)
end;
EQCMD:
if (CkP(lin, i+1, pFlag, status) = OK) then begin
PutDec(line2, 1);
PutC(NEWLINE);
end;
KCMD: begin
i := i + 1;
SkipBl(lin, i);
if (GetOne(lin, i, line3, status) = ENDDATA) then
status := ERR;
if (status = OK) then
if (CkP(lin, i, pFlag, status) = OK) then
if (Default(curLn, curLn, status) = OK) then
status := Kopy(line3)
end;
MCMD: begin
i := i + 1;
SkipBl(lin, i);
if (GetOne(lin, i, line3, status) = ENDDATA) then
status := ERR;
if (status = OK) then
if (CkP(lin, i, pFlag, status) = OK) then
if (Default(curLn, curLn, status) = OK) then
status := Move(line3)
end;
SCMD: begin
i := i + 1;
if (OptPat(lin,i) = OK) then
if (GetRHS(lin,i,sub,gFlag) = OK) then
if (CkP(lin,i+1,pFlag,status) = OK) then
if (Default(curLn,curLn,status) = OK) then
status := SubSt(sub, gFlag, glob)
end;
ECMD:
if (nLines = 0) then
if (GetFn(lin, i, fil) = OK) then begin
SCopy(fil, 1, saveFile, 1);
ClrBuf;
SetBuf;
status := DoRead(0, fil)
end;
FCMD:
if (nLines = 0) then
if (GetFn(lin,i,fil) = OK) then begin
SCopy(fil, 1, saveFile, 1);
PutStr(saveFile, STDOUT);
PutC(NEWLINE);
status := OK
end;
RCMD:
if (GetFn(lin, i, fil) = OK) then
status := DoRead(line2, fil);
WCMD:
if (GetFn(lin,i,fil) = OK) then
if (Default(1, lastLn, status) = OK) then
status := DoWrite(line1, line2, fil)
otherwise
status := ERR
end;
if (status = OK) and (pFlag) then
status := DoPrint(curLn, curLn);
DoCmd := status
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoDash -- expand set at src(i) into dest(j), stop at delim }
segment DoDash;
%include swtools
%include patdef
procedure DoDash;
var
k: CharType;
junk: Boolean;
begin
while (src[i] <> delim) and (src[i] <> ENDSTR) do begin
if (src[i] = ESCAPE) then
junk := AddStr(Esc(src,i), dest, j, maxSet)
else if (src[i] <> DASH) then
junk := AddStr(src[i], dest, j, maxSet)
else if (j <= 1) or (src[i+1] = ENDSTR) then
junk := AddStr(DASH, dest, j, maxSet) { literal -}
else if IsAlphaNum(src[i-1]) and
IsAlphaNum(src[i+1]) and
(src[i-1] <= src[i+1]) then begin
for k := Succ(src[i-1]) to src[i+1] do
{ the following obscenity is due to EBCDIC "holes" }
if IsAlphaNum(k) then begin
junk := AddStr(k, dest, j, maxSet);
end;
i := i + 1
end
else
junk := AddStr(DASH, dest, j, maxSet);
i := i + 1
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoDef -- install definition in table }
segment DoDef;
%include swtools
%include macdefs
%include macproc
procedure DoDef;
var
temp1, temp2: StringType;
begin
if (j - i > 2) then begin
CsCopy(evalStk, argStk[i+2], temp1);
CsCopy(evalStk, argStk[i+3], temp2);
Install(temp1, temp2, MACTYPE)
end {if};
end {DoDef};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoExpr -- Evaluate arithmetic expression }
segment DoExpr;
%include swtools
%include macdefs
%include macproc
procedure DoExpr;
var
temp: StringType;
junk: Integer;
begin
CsCopy(evalStk, argStk[i+2], temp);
junk := 1;
PBNum(Expr(temp, junk))
end {DoExpr};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoGlob -- do command at lin[i] on all marked lines }
segment DoGlob;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function DoGlob;
var
count, iStart, n: Integer;
begin
status := OK;
count := 0;
n := line1;
iStart := i;
repeat
if (GetMark(n)) then begin
PutMark(n, false);
curLn := n;
curSave := curLn;
i := iStart;
if (GetList(lin, i, status) = OK) then
if (DoCmd(lin, i, true, status) = OK) then
count := 0;
end
else begin
n := NextLn(n);
count := count + 1
end
until (count > lastLn) or (status <> OK);
DoGlob := status
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoIf -- Select one of two arguments }
segment DoIf;
%include swtools
%include macdefs
%include macproc
procedure DoIf;
var
temp1, temp2, temp3: StringType;
begin
if (j - i >= 4) then begin
CsCopy(evalStk, argStk[i+2], temp1);
CsCopy(evalStk, argStk[i+3], temp2);
if (Equal(temp1, temp2)) then
CsCopy(evalStk, argStk[i+4], temp3)
else if (j - i >= 5) then
CsCopy(evalStk, argStk[i+5], temp3)
else
temp3[1] := ENDSTR;
PBStr(temp3)
end {if}
end {DoIf};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoLen -- Return length of argument }
segment DoLen;
%include swtools
%include macdefs
%include macproc
procedure DoLen;
var
temp: StringType;
begin
if (j - i > 1) then begin
CsCopy(evalStk, argStk[i+2], temp);
PBNum(StrLength(temp))
end {then}
else
PBNum(0)
end {DoLen};
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoLPrint -- print lines n1 thru n2 unambiguously }
segment DoLPrint;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include chardef
function DoLPrint;
var
lp: Integer;
i: Integer;
line: StringType;
begin
if (n1 < 0) then
DoLPrint := ERR
else begin
for i := n1 to n2 do begin
GetTxt(i, line);
if OptIsOn(numFlag) then begin
PutDec(i, 5);
PutC(BLANK)
end;
for lp := 1 to StrLength(line) do begin
if CharClass(line[lp]) <> [] then
PutC(line[lp])
else if line[lp] = NEWLINE then
PutC(NEWLINE)
else begin
PutC(BACKSLASH);
PutDec(Ord(line[lp]), 3)
end
end
end;
curLn := n2;
DoLPrint := OK
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoOption -- build options for the swtools editor }
segment DoOption;
%include swtools
%include editcons
%include edittype
%include editproc
def
optionFlags: set of promptFlag..numFlag;
value
optionFlags := [];
function DoOption;
var
optSel: promptFlag..numFlag;
setting: Boolean;
begin
DoOption := OK; { error handling done here }
i := i + 1;
if (lin[i] = NEWLINE) or (lin[i+1] = NEWLINE) then
Message('Bad option string')
else begin
if lin[i+1] in [LETS, BIGS] then setting := true
else if lin[i+1] in [LETC, BIGC] then setting := false
else begin
Message('You must [s]et or [c]lear the option');
return
end;
case lin[i] of
LETP, BIGP:
optSel := promptFlag;
LETM, BIGM:
optSel := noMetaFlag;
LETV, BIGV:
optSel := verboseFlag;
LETN, BIGN:
optSel := numFlag
otherwise
begin
Message('You gave an illegal option');
Message('available options are:');
Message('ps/pc: turn on/off prompting');
Message('vs/vc: turn on/off verbose mode');
Message('ns/nc: turn on/off line numbers');
Message('ms/mc: turn on/off stupid matching');
return
end
end;
if setting then
optionFlags := optionFlags + [optSel]
else
optionFlags := optionFlags - [optSel]
end
end;
function OptIsOn;
begin
if flag in optionFlags then OptIsOn := true
else OptIsOn := false
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoPrint -- print lines n1 thru n2 }
segment DoPrint;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function DoPrint;
var
i: Integer;
line: StringType;
begin
if (n1 < 0) then
DoPrint := ERR
else begin
for i := n1 to n2 do begin
GetTxt(i, line);
if OptIsOn(numFlag) then begin
PutDec(i, 5);
PutC(BLANK)
end;
PutStr(line, STDOUT)
end;
curLn := n2;
DoPrint := OK
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoRead -- read "fil" after line n }
segment DoRead;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function DoRead;
var
count: Integer;
t: Boolean;
stat: STCode;
fd: FileDesc;
inLine: StringType;
begin
fd := FOpen(fil, IOREAD);
if (fd = IOERROR) then
stat := ERR
else begin
curLn := n;
stat := OK;
count := 0;
repeat
t := GetLine(inLine, fd, MAXSTR);
if (t) then begin
stat := PutTxt(inLine);
if (stat <> ERR) then
count := count + 1
end
until (stat <> OK) or (t = false);
FClose(fd);
PutDec(count, 1);
PutC(NEWLINE);
end;
DoRead := stat
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoSub -- Select substring }
segment DoSub;
%include swtools
%include macdefs
%include macproc
procedure DoSub;
var
ap, fc, k, nc: Integer;
temp1, temp2: StringType;
begin
if (j - i >= 3) then begin
if (j - i < 4) then
nc := MAXTOK
else begin
CsCopy(evalStk, argStk[i+4], temp1);
k := 1;
nc := Expr(temp1, k)
end {if};
CsCopy(evalStk, argStk[i+3], temp1); { origin }
ap := argStk[i+2]; { target string }
k := 1;
fc := ap + Expr(temp1, k) - 1; { first char }
CsCopy(evalStk, ap, temp2);
if (fc >= ap) and (fc < ap + StrLength(temp2)) then begin
CsCopy(evalStk, fc, temp1);
for k := fc + Min(nc, StrLength(temp1))-1 downto fc do
PutBack(evalStk[k])
end {if}
end {if}
end {DoSub};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ DoWrite -- write lines n1..n2 into file }
segment DoWrite;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function DoWrite;
var
i: Integer;
fd: FileDesc;
line: StringType;
begin
fd := FCreate(fil, IOWRITE);
if (fd = IOERROR) then
DoWrite := ERR
else begin
for i := n1 to n2 do begin
GetTxt(i, line);
PutStr(line,fd)
end;
FClose(fd);
PutDec(n2-n1+1, 1);
PutC(NEWLINE);
DoWrite := OK
end
end;