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 >
Pascal/Delphi Source File  |  1987-03-25  |  7KB  |  157 lines
  1. (* +FILE+ DEFWORDS.PASMSCPM *)
  2. (* Global DefWord variables *)
  3. Var
  4.     DefFile : text ;
  5.     NewDefs : boolean ;
  6.     DefList : DefPointer ;
  7.  
  8. (* ================================================================== *)
  9. (* AssignDefWord  - Assigns the Defined Word  into the DefList.       *)
  10. (*                   This is a recursive procedure.                   *)
  11. (* Side Affects : The boolean variable NewDefs is set true            *)
  12. (* ================================================================== *)
  13. Procedure AssignDefWord (var PT : DefPointer;
  14.                           DWord:Wstring ; Dstring: comstring);
  15. Var TempPt : DefPointer ;
  16. Begin (* AssignDefWord Procedure *)
  17. NewDefs := true ;
  18. TempPt := PT;
  19. If PT <> nil then
  20.     With PT^ do
  21.          If DefWord = Dword then         (* Found existing Word *)
  22.              If length(Dstring) > 0 then
  23.                   DefString := Dstring
  24.                                     else
  25.                   Begin (* Drop DefWord *)
  26.                   PT := Link ;  (* Drop entry *)
  27.                   Dispose(tempPT);
  28.                   End   (* Drop DefWord *)
  29.  
  30.                             else        (* Look down the list *)
  31.              AssignDefWord(Link,DWord,Dstring)
  32.  
  33.             else
  34.     If length(Dstring) > 0 then
  35.          Begin (* Add new entry *)
  36.          New(PT);
  37.          With PT^ do
  38.               Begin (* Add DefWord to list *)
  39.               Link := Nil ;
  40.               DefWord := DWord ;
  41.               DefString := Dstring ;
  42.               End;
  43.          End ; (* Add new entry *)
  44. End ; (* AssignDefWord Procedure *)
  45.  
  46.  
  47. (* ================================================================== *)
  48. (* DisplayDefWords - display the Defined Words in the DefList.        *)
  49. (*                   This is a recursive procedure.                   *)
  50. (*                                                                    *)
  51. (* ================================================================== *)
  52. Procedure DisplayDefWords (PT : DefPointer);
  53. Begin (* DisplayDefWords Procedure *)
  54. If PT <> nil then
  55.       With PT^ do
  56.          Begin (* Display Word and definition *)
  57.          Writeln(DefWord,' := ',DefString);
  58.          DisplayDefWords(Link);
  59.          End ;
  60. End ; (* DisplayDefWords Procedure *)
  61. (* ================================================================== *)
  62. (* CheckDefWords - Checks  for   Defined Words in the DefList.        *)
  63. (*                 If it is found it concationates the DefString      *)
  64. (*                 to the Instring and reset the first token          *)
  65. (*                   This is a recursive procedure.                   *)
  66. (*                                                                    *)
  67. (* ================================================================== *)
  68. Procedure CheckDefWords (PT : DefPointer;
  69.                              var Dword : Wstring ; var Instring: comstring);
  70. Begin (* CheckDefWords Procedure *)
  71. If PT <> nil then
  72.     With PT^ do
  73.          If Dword = DefWord then
  74.               Begin (* Update string *)
  75.               Instring := DefString + ' ' + Instring ;
  76.               Dword := uppercase(GetToken(Instring));
  77.               End
  78.                            else
  79.               CheckDefWords(Link,Dword,Instring)
  80. End ; (* CheckDefWords Procedure *)
  81.  
  82. (* ================================================================== *)
  83. (* WriteDefWord - writes  the Defined Words in the DefList to the    *)
  84. (*                 DefFile.                                           *)
  85. (*                                                                    *)
  86. (* ================================================================== *)
  87. Procedure WriteDefWord (PT : DefPointer);
  88. Begin (* WriteDefWord Procedure *)
  89. If PT <> nil then
  90.       With PT^ do
  91.          Begin (* Write word and definition *)
  92.          Writeln(DefFile,DefWord,' ',DefString);
  93.          WriteDefWord(Link);
  94.          End ;
  95. End ; (* WriteDefWord Procedure *)
  96.  
  97. (* ================================================================== *)
  98. (* DEFINEWORD - This procedure processes the DEFINE command.          *)
  99. (*              It searches the DefList for the WORD specified        *)
  100. (*              If it is found it replaces the definition string      *)
  101. (*              with the new definition. Otherwise it creates an      *)
  102. (*              new entry in the DefList.                             *)
  103. (* ================================================================== *)
  104. Procedure DEFINEWORD (Var Instring: comstring);
  105. Var
  106.     DWord : string[10] ;
  107.  
  108. Begin (* DefineWord Procedure *)
  109. If length(Instring) < 1 then
  110.     If DefList = Nil then  Writeln(' No Defined Words ')
  111.                      else  DisplayDefWords (DefList)
  112.                         else
  113.     Begin (* Assign Defined Word *)
  114.     DWord :=   Uppercase(GetToken(Instring));
  115.     While (instring[1] = ' ') and (length(instring)>0) do
  116.           Delete(instring,1,1);    (* eliminate leading blanks *)
  117.     AssignDefWord(DefList,DWord,Instring);
  118.     Instring := '';
  119.     End ; (* Assign Define Word *)
  120. End;  (* DefineWord Procedure *)
  121.  
  122. (* ================================================================== *)
  123. (* LoadDefWords  - Loads the Defined Words into the DefList from      *)
  124. (*                 the file KERMIT.DEF.                               *)
  125. (*                                                                    *)
  126. (* ================================================================== *)
  127. Procedure LoadDefWords ;
  128. Var Instring,dummy : comstring ;
  129. Begin (* LoadDefWord Procedure *)
  130. If FirstFile('KERMIT.DEF',DUMMY) then
  131.     Begin (* Read file *)
  132.     Assign(DefFile,'KERMIT.DEF');
  133.     Reset(DefFile);
  134.     While not Eof(DefFile) do
  135.          Begin (* load DefList *)
  136.          Readln(DefFile,Instring);
  137.          DefineWord(Instring);
  138.          End ; (* load DefList *)
  139.     End ; (* Read file *)
  140. End ; (* LoadDefWord Procedure *)
  141.  
  142. (* ================================================================== *)
  143. (* SaveDefWords  - Saves the Defined Words from the DefList into      *)
  144. (*                 the file KERMIT.DEF.                               *)
  145. (*                                                                    *)
  146. (* ================================================================== *)
  147. Procedure SaveDefWords ;
  148. Var Instring : comstring ;
  149. Begin (* SaveDefWord Procedure *)
  150. Writeln('Saving  DEFINE words in file KERMIT.DEF');
  151. Assign(DefFile,'KERMIT.DEF');
  152. Rewrite(DefFile);
  153. WriteDefWord(DefList);
  154. Close(DefFile);
  155. End ; (* SaveDefWord Procedure *)
  156.  
  157.