home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
queenskermit.tar.gz
/
queenskermit.tar
/
defwords.pas
next >
Wrap
Pascal/Delphi Source File
|
1988-12-14
|
7KB
|
183 lines
Unit Defwords ;
Interface
Uses Dos, (* Standard Turbo Pascal Unit *)
KGlobals ; (* Kermit Globals *)
Type
DefPointer = ^ DefineRec ;
DefineRec = Record
Link : DefPointer ;
DefWord : string ;
DefString: string ;
End ;
Var NewDefs : boolean ;
DefList : DefPointer ;
Procedure AssignDefWord (var PT : DefPointer;
DWord: string ; Dstring: string);
Procedure DisplayDefWords (PT : DefPointer);
Procedure CheckDefWords (PT : DefPointer;
var Dword : string ; var Instring: String);
Procedure DEFINEWORD (Var Instring: String);
Procedure LoadDefWords ;
Procedure SaveDefWords ;
Implementation
Var
DefFile : text ;
(* ================================================================== *)
(* 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:String ; Dstring: String);
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 : String ; var Instring: String);
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: String);
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 : String ;
Begin (* LoadDefWord Procedure *)
Assign(DefFile,'KERMIT.DEF');
{$I-}
Reset(DefFile);
if IOResult <> 0 then writeln(' No file KERMIT.DEF ')
else
{$I+}
While not Eof(DefFile) do
Begin (* load DefList *)
Readln(DefFile,Instring);
DefineWord(Instring);
End ; (* load DefList *)
NewDefs := False ;
End ; (* LoadDefWord Procedure *)
(* ================================================================== *)
(* SaveDefWords - Saves the Defined Words from the DefList into *)
(* the file KERMIT.DEF. *)
(* *)
(* ================================================================== *)
Procedure SaveDefWords ;
Var Instring : String ;
Begin (* SaveDefWord Procedure *)
Writeln('Saving DEFINE words in file KERMIT.DEF');
Assign(DefFile,'KERMIT.DEF');
Rewrite(DefFile);
WriteDefWord(DefList);
Close(DefFile);
End ; (* SaveDefWord Procedure *)
Begin (* Defwords Unit *)
Deflist := Nil ;
LoadDefWords ;
End. (* Defwords Unit *)