home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / CIT3.MQD / CIT3.MOD
Text File  |  2000-06-30  |  5KB  |  183 lines

  1. { Patch Routine for T-Room by Matt Wing - Find/Replace Routine for editor.}
  2. { Also some Misc. Routines at the end of file. This is NOT a include file.}
  3. { You must type this in or use ^K^R in your Wordstar or Turbo Editor.     }
  4. { August '86 - DST }
  5. { August '86 - DST Updated error in Replace and More trivial routines..}
  6. { Sept. '86 - DST Added the upper to lowercase routine. }
  7.  
  8. { Add in Cit.Pas - Var define.. }
  9. replace_string,target_string:string[80];
  10.  
  11. { Ok, you are under the editcommand loop.. }
  12.  
  13. if keyin='?' then.. {Example..}
  14. if keyin='S' then..
  15. if keyin='R' then
  16.  begin    { Find/Replace Start }
  17.   writeln('eplace string');
  18.   write('Enter string: ');
  19.   readln(replace_string);
  20.   count:=0;
  21.   count1:=1;
  22.   savecol:=colposition;
  23.   colposition:=1;
  24.   repeat
  25.    begin
  26.     count:=pos(replace_string,editline[count1];
  27.     count1:=count1+1;
  28.    end;
  29.   until (count1>=row) or (count<>0);
  30.   if count<>0 then
  31.    begin
  32.     write('"',replace_string,'" is replaced with =-> ');
  33.     readln(target_string);
  34.     delete(editline[count1-1],count,length(replace_string));
  35.     insert(target_string,editline[count1-1],count);writeln;
  36.     writeln(editline[count1-1]);
  37.     write(' ':count-1);                        {These 3 lines write the }
  38.     for count:=1 to length(target_string) do   { ^'s that point to the  }
  39.      write('^');                               { Correction made..      }
  40.      writeln;
  41.    end;
  42.   if count=0 then writeln('"',replace_string,'" not found. Check spelling.');
  43.   goto editcommand;
  44.  end; { replace string }
  45.  
  46. { This next routine is added to Cit.Pas - Allows the user to .Goto rooms }
  47. { without having to type in the whole room.
  48. Example:
  49. .Goto <space>news
  50.  will take you to 'System News' or whatever room that has 'news' in it.. }
  51. if keyin='.' then..
  52.  if character='G'..
  53.   while count1<=15 do
  54.    begin
  55.     compstring:=rooma[count1];
  56.     upcaseconv(compstring);
  57. {new} if (pos(instring, compstring)>0) then
  58. {replaces 'if compstring=instring then'..}
  59.      begin
  60.        lastread[roompoint]:=nextmessnum-1;
  61.        ...
  62. { If you add this patch, you also have to switch this routine: }
  63.  
  64. procedure upcaseconv(var tranchar:word25);
  65.  begin
  66.    len:=length(tranchar);
  67.    oustring:='';
  68.    count:=1;
  69.    while count <= len do
  70.      begin
  71.        character:=tranchar[count];
  72.        if character in ['a'..'z'] then character:=chr(ord(character)-32_;
  73.        outstring:=outstring+character;
  74.        count:=count+1;
  75.      end;
  76.    tranchar:=oustring;
  77.  end;
  78.  
  79. oh yeah, and add :
  80.  
  81. if room='Mail' then
  82. writeln('  ',date,' from ',username,' to ',mailname);
  83. (for user's ease..)
  84. if room<>'Mail' then
  85. writeln('  ',date,' from ',username);
  86.  
  87. And one more thing:
  88. procedure pause;
  89.  
  90. Add:
  91.  if (chr(kbdin)='P') OR (chr(kbdin)=#$13) then ....
  92.  
  93. And at the bottom:
  94.  if chr(kbdin)=#$03 then stopflag:=true;
  95.  if chr(kbdin)='S'...
  96.  
  97. { This allows ^S and ^C (<P>ause and <S>top) }
  98.  
  99. AND another thing with the I/O stuff, I modified mine to I/O check only
  100. between words.. like:
  101.  
  102. Procedure Dumpfile;
  103. begin...
  104. ...
  105. begin
  106.  character:=copy(line,count,1)
  107.  write(character);
  108.  count:=count+1;
  109.  if character=' ' then
  110.   pause;
  111.  if stopflag=true then
  112.  begin...
  113. { Above might just be a nuisance }
  114.  
  115. { Ok, finally figured out how to heed the english syntax for the upper to
  116.   lowercase conversion.  Here is the installation routine: }
  117.  
  118. { Find editcommand loop under 'Enter message'.. Find the 'S'ave routine}
  119. if keyin='S' then
  120.  begin
  121.    writeln('aving message.');
  122.    buffercnt:=1;...
  123.     ...
  124.     ...
  125.    count:=endpoint+3;
  126.    endpoint:=count+row-1;
  127.    while count<endpoint do
  128.     begin
  129. { Add >> }  switch(editline[buffercnt], buffercnt); { << Add }
  130.      count:=count+1;
  131.      buffercnt:=buffercnt+1;
  132.      ...
  133.  
  134. { Now, under CIT2.PAS or any other include file, insert the following
  135.  procedure :}
  136.  Procedure Switch(var liner: Word80; Num: integer);
  137.  var counter: integer;
  138.      c: char;
  139.      f, caps: boolean;
  140.      sw: string[80];
  141.  
  142.   begin
  143.     counter:=1;
  144.     f:=true;
  145.    while (counter<=length(liner)) and (f) do
  146.      begin
  147.        c:=liner[counter];
  148.        counter:=counter+1;
  149.        if c in ['a'..'z'] then f:=false
  150.       else
  151.        f:=true
  152.      end;
  153.     if (f) then
  154.      begin
  155.       counter:=1;
  156.       caps:=false;
  157.       sw:='';
  158.     while counter<=length(liner) do
  159.      begin
  160.       c:=liner[counter];
  161.      if (num=1) and (counter=1) then   { Cap 1st letter in 1st line..}
  162.       caps:=true;
  163.      if (c in ['.','(','?','!']) then  { Any more signs I didn't think of?}
  164.       caps:=true;
  165.      if (c in ['A'..'Z']) and (not caps) then
  166.        c:=chr(ord(c)+32);
  167.      if (caps) and (c in ['A'..'Z']) then
  168.       caps:=false;
  169.      sw:=sw+c;
  170.      counter:=counter+1;
  171.     end;
  172.    liner:=sw;
  173.   end;
  174.  end;
  175.  
  176.  
  177. { I originally had this in 2 separate functions and procedures, but figured
  178.  I wouldn't use a 'Check_to_see_if_a_lower_case_letter_exists' procedure
  179.  more than once.. If you want to maintain the modular type programming you
  180.  can break 'em up.. thought I would save a little code space this way.. }
  181.  
  182. - Dave T.
  183.