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 *)