home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
TPKERMIT
/
DEFWORDS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-03-25
|
7KB
|
157 lines
(* +FILE+ DEFWORDS.PASMSCPM *)
(* Global DefWord variables *)
Var
DefFile : text ;
NewDefs : boolean ;
DefList : DefPointer ;
(* ================================================================== *)
(* AssignDefWord - Assigns the Defined Word into the DefList. *)
(* This is a recursive procedure. *)
(* Side Affects : The boolean variable NewDefs is set true *)
(* ================================================================== *)
Procedure AssignDefWord (var PT : DefPointer;
DWord:Wstring ; Dstring: comstring);
Var TempPt : DefPointer ;
Begin (* AssignDefWord Procedure *)
NewDefs := true ;
TempPt := PT;
If PT <> nil then
With PT^ do
If DefWord = Dword then (* Found existing Word *)
If length(Dstring) > 0 then
DefString := Dstring
else
Begin (* Drop DefWord *)
PT := Link ; (* Drop entry *)
Dispose(tempPT);
End (* Drop DefWord *)
else (* Look down the list *)
AssignDefWord(Link,DWord,Dstring)
else
If length(Dstring) > 0 then
Begin (* Add new entry *)
New(PT);
With PT^ do
Begin (* Add DefWord to list *)
Link := Nil ;
DefWord := DWord ;
DefString := Dstring ;
End;
End ; (* Add new entry *)
End ; (* AssignDefWord Procedure *)
(* ================================================================== *)
(* DisplayDefWords - display the Defined Words in the DefList. *)
(* This is a recursive procedure. *)
(* *)
(* ================================================================== *)
Procedure DisplayDefWords (PT : DefPointer);
Begin (* DisplayDefWords Procedure *)
If PT <> nil then
With PT^ do
Begin (* Display Word and definition *)
Writeln(DefWord,' := ',DefString);
DisplayDefWords(Link);
End ;
End ; (* DisplayDefWords Procedure *)
(* ================================================================== *)
(* CheckDefWords - Checks for Defined Words in the DefList. *)
(* If it is found it concationates the DefString *)
(* to the Instring and reset the first token *)
(* This is a recursive procedure. *)
(* *)
(* ================================================================== *)
Procedure CheckDefWords (PT : DefPointer;
var Dword : Wstring ; var Instring: comstring);
Begin (* CheckDefWords Procedure *)
If PT <> nil then
With PT^ do
If Dword = DefWord then
Begin (* Update string *)
Instring := DefString + ' ' + Instring ;
Dword := uppercase(GetToken(Instring));
End
else
CheckDefWords(Link,Dword,Instring)
End ; (* CheckDefWords Procedure *)
(* ================================================================== *)
(* WriteDefWord - writes the Defined Words in the DefList to the *)
(* DefFile. *)
(* *)
(* ================================================================== *)
Procedure WriteDefWord (PT : DefPointer);
Begin (* WriteDefWord Procedure *)
If PT <> nil then
With PT^ do
Begin (* Write word and definition *)
Writeln(DefFile,DefWord,' ',DefString);
WriteDefWord(Link);
End ;
End ; (* WriteDefWord Procedure *)
(* ================================================================== *)
(* DEFINEWORD - This procedure processes the DEFINE command. *)
(* It searches the DefList for the WORD specified *)
(* If it is found it replaces the definition string *)
(* with the new definition. Otherwise it creates an *)
(* new entry in the DefList. *)
(* ================================================================== *)
Procedure DEFINEWORD (Var Instring: comstring);
Var
DWord : string[10] ;
Begin (* DefineWord Procedure *)
If length(Instring) < 1 then
If DefList = Nil then Writeln(' No Defined Words ')
else DisplayDefWords (DefList)
else
Begin (* Assign Defined Word *)
DWord := Uppercase(GetToken(Instring));
While (instring[1] = ' ') and (length(instring)>0) do
Delete(instring,1,1); (* eliminate leading blanks *)
AssignDefWord(DefList,DWord,Instring);
Instring := '';
End ; (* Assign Define Word *)
End; (* DefineWord Procedure *)
(* ================================================================== *)
(* LoadDefWords - Loads the Defined Words into the DefList from *)
(* the file KERMIT.DEF. *)
(* *)
(* ================================================================== *)
Procedure LoadDefWords ;
Var Instring,dummy : comstring ;
Begin (* LoadDefWord Procedure *)
If FirstFile('KERMIT.DEF',DUMMY) then
Begin (* Read file *)
Assign(DefFile,'KERMIT.DEF');
Reset(DefFile);
While not Eof(DefFile) do
Begin (* load DefList *)
Readln(DefFile,Instring);
DefineWord(Instring);
End ; (* load DefList *)
End ; (* Read file *)
End ; (* LoadDefWord Procedure *)
(* ================================================================== *)
(* SaveDefWords - Saves the Defined Words from the DefList into *)
(* the file KERMIT.DEF. *)
(* *)
(* ================================================================== *)
Procedure SaveDefWords ;
Var Instring : comstring ;
Begin (* SaveDefWord Procedure *)
Writeln('Saving DEFINE words in file KERMIT.DEF');
Assign(DefFile,'KERMIT.DEF');
Rewrite(DefFile);
WriteDefWord(DefList);
Close(DefFile);
End ; (* SaveDefWord Procedure *)