home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / QK3KER.ZIP / QK3DEF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-05-17  |  7.2 KB  |  184 lines
  1. Unit DefWords;
  2. Interface
  3.   Uses Dos,             (* Standard Turbo Pascal Unit *)
  4.        KGlobals ;       (* Kermit Globals *)
  5.   Type
  6.      DefPointer = ^ DefineRec ;
  7.      DefineRec = Record
  8.                  Link : DefPointer ;
  9.                  DefWord : string ;
  10.                  DefString: string ;
  11.                  End ;
  12.   Var NewDefs : boolean ;
  13.       DefList : DefPointer ;
  14.      Procedure AssignDefWord (var PT : DefPointer;
  15.                               DWord: string ; Dstring: string);
  16.      Procedure DisplayDefWords (PT : DefPointer);
  17.      Procedure CheckDefWords (PT : DefPointer;
  18.                               var Dword : string ; var Instring: String);
  19.      Procedure DEFINEWORD (Var Instring: String);
  20.      Procedure LoadDefWords ;
  21.      Procedure SaveDefWords ;
  22. Implementation
  23.  
  24. Var
  25.     DefFile : text ;
  26.  
  27. (* ================================================================== *)
  28. (* AssignDefWord  - Assigns the Defined Word  into the DefList.       *)
  29. (*                   This is a recursive procedure.                   *)
  30. (* Side Affects : The boolean variable NewDefs is set true            *)
  31. (* ================================================================== *)
  32. Procedure AssignDefWord (var PT : DefPointer;
  33.                           DWord:String ; Dstring: String);
  34. Var TempPt : DefPointer ;
  35. Begin (* AssignDefWord Procedure *)
  36. NewDefs := true ;
  37. TempPt := PT;
  38. If PT <> nil then
  39.     With PT^ do
  40.          If DefWord = Dword then         (* Found existing Word *)
  41.              If length(Dstring) > 0 then
  42.                   DefString := Dstring
  43.                                     else
  44.                   Begin (* Drop DefWord *)
  45.                   PT := Link ;  (* Drop entry *)
  46.                   Dispose(tempPT);
  47.                   End   (* Drop DefWord *)
  48.  
  49.                             else        (* Look down the list *)
  50.              AssignDefWord(Link,DWord,Dstring)
  51.  
  52.             else
  53.     If length(Dstring) > 0 then
  54.          Begin (* Add new entry *)
  55.          New(PT);
  56.          With PT^ do
  57.               Begin (* Add DefWord to list *)
  58.               Link := Nil ;
  59.               DefWord := DWord ;
  60.               DefString := Dstring ;
  61.               End;
  62.          End ; (* Add new entry *)
  63. End ; (* AssignDefWord Procedure *)
  64.  
  65.  
  66. (* ================================================================== *)
  67. (* DisplayDefWords - display the Defined Words in the DefList.        *)
  68. (*                   This is a recursive procedure.                   *)
  69. (*                                                                    *)
  70. (* ================================================================== *)
  71. Procedure DisplayDefWords (PT : DefPointer);
  72. Begin (* DisplayDefWords Procedure *)
  73. If PT <> nil then
  74.       With PT^ do
  75.          Begin (* Display Word and definition *)
  76.          Writeln(DefWord,' := ',DefString);
  77.          DisplayDefWords(Link);
  78.          End ;
  79. End ; (* DisplayDefWords Procedure *)
  80. (* ================================================================== *)
  81. (* CheckDefWords - Checks  for   Defined Words in the DefList.        *)
  82. (*                 If it is found it concationates the DefString      *)
  83. (*                 to the Instring and reset the first token          *)
  84. (*                   This is a recursive procedure.                   *)
  85. (*                                                                    *)
  86. (* ================================================================== *)
  87. Procedure CheckDefWords (PT : DefPointer;
  88.                              var Dword : String ; var Instring: String);
  89. Begin (* CheckDefWords Procedure *)
  90. If PT <> nil then
  91.     With PT^ do
  92.          If Dword = DefWord then
  93.               Begin (* Update string *)
  94.               Instring := DefString + ' ' + Instring ;
  95.               Dword := uppercase(GetToken(Instring));
  96.               End
  97.                            else
  98.               CheckDefWords(Link,Dword,Instring)
  99. End ; (* CheckDefWords Procedure *)
  100.  
  101. (* ================================================================== *)
  102. (* WriteDefWord - writes  the Defined Words in the DefList to the    *)
  103. (*                 DefFile.                                           *)
  104. (*                                                                    *)
  105. (* ================================================================== *)
  106. Procedure WriteDefWord (PT : DefPointer);
  107. Begin (* WriteDefWord Procedure *)
  108. If PT <> nil then
  109.       With PT^ do
  110.          Begin (* Write word and definition *)
  111.          Writeln(DefFile,DefWord,' ',DefString);
  112.          WriteDefWord(Link);
  113.          End ;
  114. End ; (* WriteDefWord Procedure *)
  115.  
  116. (* ================================================================== *)
  117. (* DEFINEWORD - This procedure processes the DEFINE command.          *)
  118. (*              It searches the DefList for the WORD specified        *)
  119. (*              If it is found it replaces the definition string      *)
  120. (*              with the new definition. Otherwise it creates an      *)
  121. (*              new entry in the DefList.                             *)
  122. (* ================================================================== *)
  123. Procedure DEFINEWORD (Var Instring: String);
  124. Var
  125.     DWord : string[10] ;
  126.  
  127. Begin (* DefineWord Procedure *)
  128. If length(Instring) < 1 then
  129.     If DefList = Nil then  Writeln(' No Defined Words ')
  130.                      else  DisplayDefWords (DefList)
  131.                         else
  132.     Begin (* Assign Defined Word *)
  133.     DWord :=   Uppercase(GetToken(Instring));
  134.     While (instring[1] = ' ') and (length(instring)>0) do
  135.           Delete(instring,1,1);    (* eliminate leading blanks *)
  136.     AssignDefWord(DefList,DWord,Instring);
  137.     Instring := '';
  138.     End ; (* Assign Define Word *)
  139. End;  (* DefineWord Procedure *)
  140.  
  141. (* ================================================================== *)
  142. (* LoadDefWords  - Loads the Defined Words into the DefList from      *)
  143. (*                 the file KERMIT.DEF.                               *)
  144. (*                                                                    *)
  145. (* ================================================================== *)
  146. Procedure LoadDefWords ;
  147. Var Instring : String ;
  148.  
  149. Begin (* LoadDefWord Procedure *)
  150.     Assign(DefFile,'KERMIT.DEF');
  151.     {$I-}
  152.     Reset(DefFile);
  153.     if IOResult <> 0 then writeln(' No file KERMIT.DEF ')
  154.                      else
  155.     {$I+}
  156.     While not Eof(DefFile) do
  157.          Begin (* load DefList *)
  158.          Readln(DefFile,Instring);
  159.          DefineWord(Instring);
  160.          End ; (* load DefList *)
  161. NewDefs := False ;
  162. End ; (* LoadDefWord Procedure *)
  163.  
  164. (* ================================================================== *)
  165. (* SaveDefWords  - Saves the Defined Words from the DefList into      *)
  166. (*                 the file KERMIT.DEF.                               *)
  167. (*                                                                    *)
  168. (* ================================================================== *)
  169. Procedure SaveDefWords ;
  170. Var Instring : String ;
  171. Begin (* SaveDefWord Procedure *)
  172. Writeln('Saving  DEFINE words in file KERMIT.DEF');
  173. Assign(DefFile,'KERMIT.DEF');
  174. Rewrite(DefFile);
  175. WriteDefWord(DefList);
  176. Close(DefFile);
  177. End ; (* SaveDefWord Procedure *)
  178.  
  179.  
  180. Begin (* Defwords Unit *)
  181. Deflist := Nil ;
  182. LoadDefWords ;
  183. End. (* Defwords Unit *)
  184.