Jason Aller Floppy Collection/270.img/FORUM25C.ZIP/LINEEDIT.PAS

Pascal/Delphi Source File | 1988-12-27 | 9KB | 398 lines

{$R-,S-,I-,D-,V-,B-,N-,L- }
{$O+}

unit lineedit;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

interface

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}


uses gentypes,configrt,gensubs,subs1,subs2;

Function linereedit (VAR m:message; gettitle:boolean):boolean;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

implementation

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}


Function linereedit (VAR m:message; gettitle:boolean):boolean;
VAR done,editmode:boolean;
    curline,r1,r2,cols:integer;

  Procedure init;
  begin
    if eightycols in urec.config
      then cols:=79
      else cols:=39;
    linereedit:=false;
    done:=false;
    editmode:=false;
    curline:=1;
    if m.numlines=0
      then writeln (^B^M'Enter text, ',maxmessagesize,' lines at most')
      else begin
        writeln (^B^M'Re-editing message.');
        writeln ('Current size: '^S,m.numlines);
        writeln ('Note: Inserting before line 1.');
        writeln ('/A will abort changes.'^M)
      end;
    writeln ('Enter /? for help on / commands'^B^M)
  end;

  Procedure setbreak;
  begin
    clearbreak;
    nobreak:=true;
    dontstop:=true;
    wordwrap:=true;
    linecount:=0
  end;

  Function msgisblank:boolean;
  begin
    if m.numlines>0 then msgisblank:=false else begin
      writestr ('Sorry, message blank!');
      msgisblank:=true
    end
  end;

  Function getrange:boolean;
  begin
    parserange (m.numlines,r1,r2);
    getrange:=r1<>0
  end;

  Function getlinenum (txt:mstr):boolean;
  begin
    writestr ('Line number to '+txt+':');
    r1:=valu(input);
    r2:=r1;
    if (r1>=1) and (r1<=m.numlines)
      then getlinenum:=true
      else begin
        getlinenum:=false;
        writeln (^R'Invalid line!')
      end
  end;

  Procedure inslines (r1,r2:integer);
  VAR n,cnt:integer;
  begin
    n:=r2-r1+1;
    m.numlines:=m.numlines+n;
    for cnt:=m.numlines downto r2+1 do m.text[cnt]:=m.text[cnt-n]
  end;

  Procedure dellines (r1,r2:integer);
  VAR n,cnt:integer;
  begin
    n:=r2-r1+1;
    m.numlines:=m.numlines-n;
    for cnt:=r1 to m.numlines do m.text[cnt]:=m.text[cnt+n]
  end;

  Procedure insertline;
  VAR cnt:integer;
  begin
    if m.numlines=maxmessagesize then exit;
    inslines (curline,curline);
    m.text[curline]:=input;
    curline:=curline+1
  end;

  Function iseditcommand:boolean;
  begin
    iseditcommand := ((input[1]='/') and (length(input)>0));
  end;

  Function userissure:boolean;
  begin
    writestr ('Warning!  Message will be erased!');
    writestr ('Confirm [y/n]:');
    userissure:=yes
  end;

  Procedure topofmsg;
  begin
    writeln (^R'[Top of msg]')
  end;

  Procedure abortmes;
  begin
    done:=userissure
  end;

  Procedure backline;
  begin
    if m.numlines<1 then begin
      topofmsg;
      exit
    end;
    writeln (^R'[Correct previous line]');
    curline:=curline-1;
    dellines (curline,curline)
  end;

  Procedure continuemes;
  begin
    writeln (^B^R^M'Continue your message...');
    curline:=m.numlines+1;
    editmode:=false
  end;

  Procedure deletelines;
  begin
    if not getrange then exit;
    if (r1=1) and (r2=m.numlines) then begin
      writestr ('Delete whole message? *');
      if not yes then exit
    end;
    dellines (r1,r2)
  end;

  Procedure seteditmode;
  begin
    if editmode
      then writestr ('You are already in edit mode!')
      else editmode:=true
  end;

  Procedure fixline;
  VAR tmp:lstr;
  begin
    if not getlinenum ('fix') then exit;
    setbreak;
    writeln ('Line currently reads:');
    writeln (m.text[r1],^M);
    wordwrap:=false;
    buflen:=cols;
    beginwithspacesok:=true;
    writestr ('Enter new line:'^M'*');
    if length(input)<>0 then m.text[r1]:=input;
    continuemes
  end;

  Procedure insertlines;
  begin
    if not getlinenum ('insert before') then continuemes;
    curline:=r1
  end;

  Procedure listmes;
  VAR cnt,r1,r2:integer;
      linenum:boolean;
  begin
    if msgisblank then exit;
    parserange (m.numlines,r1,r2);
    if r1=0 then exit;
    writestr ('Line numbers? *');
    linenum:=yes;
    write (^R);
    for cnt:=r1 to r2 do begin
      if linenum then writeln (cnt,':');
      writeln (m.text[cnt]);
      if break then exit
    end
  end;

  Procedure centerline;
  VAR spaces:lstr;
  begin
    fillchar (spaces[1],80,32);
    if editmode then begin
      setbreak;
      buflen:=cols;
      wordwrap:=false;
      writestr ('Enter line to center:'^M'*')
    end else delete(input,1,1);
    while (length(input)>0) and (input[1]=' ') do delete (input,1,1);
    if length(input)=0 then exit;
    spaces[0]:=chr((cols-length(input)) div 2);
    input:=spaces+input;
    insertline
  end;

  Procedure clearmes;
  begin
    if userissure then begin
      writestr ('Starting message over...');
      m.numlines:=0;
      curline:=1
    end
  end;

  Procedure searchandreplace;
  VAR sfor,repw:lstr;
      l:^lstr;
      ask:boolean;
      cl,cp,sl,max:integer;

    Procedure replace;
    VAR new,old:lstr;
    begin
      old:=copy (l^,cp,sl);
      new:=repw;
      if length(new)>0 then
        if old[1] in ['A'..'Z']
          then new[1]:=upcase(new[1]);
      delete (l^,cp,sl);
      while length(l^)+length(new)>cols do l^[0]:=pred(l^[0]);
      insert (new,l^,cp);
      cp:=cp+length(new)-1
    end;

    Procedure maybereplace;
    VAR cnt:integer;
    begin
      if ask then begin
        writeln (^B^M,cl,':'^M,l^);
        for cnt:=1 to cp-1 do write (' ');
        for cnt:=1 to sl do write ('^');
        writeln;
        writestr ('Replace [Y/N]:');
        if not yes then exit
      end;
      replace
    end;

  begin
    if msgisblank then exit;
    writestr ('Search for:');
    if length(input)=0 then exit;
    sfor:=upstring(input);
    sl:=length(input);
    writestr ('Replace with:');
    repw:=input;
    writestr ('Ask each time? *');
    ask:=yes;
    max:=length(l^)-sl+1;
    for cl:=1 to m.numlines do begin
      l:=addr(m.text[cl]);
      max:=length(l^)-sl+1;
      cp:=0;
      while cp<max do begin
        cp:=cp+1;
        if match(sfor,copy(l^,cp,sl)) then maybereplace;
        max:=length(l^)-sl+1
      end
    end;
    writeln (^B^M'Search and replace complete')
  end;

  Procedure savemes;
  begin
    done:=true;
    if m.numlines=0
      then writestr ('Message blank!')
      else begin
        writestr ('Saving..');
        linereedit:=true
      end
  end;

  Procedure retitle;
  begin
    if gettitle then begin
      writeln (^R'Title is: '^S+m.title);
      writestr ('Enter new title: &');
      if length(input)>0 then m.title:=input
    end else writestr ('This message can''t have a title.')
  end;

  Procedure edithelp;
  begin
    printfile (textfiledir+'Edithelp.');
    editmode:=true
  end;

  Procedure editcommand;
  VAR k:char;
  begin
    while iseditcommand and (length(input)>0) do delete (input,1,1);
    if length(input)=0 then begin
      editmode:=true;
      exit
    end;
    k := upcase(input[1]);
    case k of
      'A': abortmes;
      'B': backline;
      'C': continuemes;
      'D': deletelines;
      'E': seteditmode;
      'F': fixline;
      'I': insertlines;
      'L': listmes;
      'M': centerline;
      'N': clearmes;
      'R': searchandreplace;
      'S': savemes;
      'T': retitle
      else
        edithelp
    end
  end;

  Procedure editcommands;
  begin
    editcommand;
    while editmode and not done do begin
      writestr (^M'Edit command [?=help]:');
      if hungupon then done:=true else editcommand
    end
  end;

  Procedure getline;
  begin
    setbreak;
    input:='/E';
    if m.numlines=maxmessagesize then begin
      writeln ('Sorry, message is full!');
      exit
    end;
    if hungupon then exit;
    if m.numlines=maxmessagesize-3 then writeln ('3 lines left!');
    if curline>m.numlines+1 then curline:=m.numlines+1;
    lastprompt:='Continue your message...'^M;
    buflen := cols;
    getstr;
    IF Input=^H
      then if curline>1
        then
          begin
            writeln ('[ Previous Line ]');
            curline:=curline-1;
            chainstr:=m.text[curline];
            dellines (curline,curline)
          end
        else topofmsg
      else if not iseditcommand then insertline
  end;

  Procedure getlines;
  begin
    repeat
      getline
    until hungupon or iseditcommand or (m.numlines=maxmessagesize);
    if not iseditcommand then input:='/'
  end;

begin
  init;
  repeat
    getlines;
    editcommands
  until done;
  writeln (^B^M^M)
end;

end.