Shareware Overload/ShartewareOverload.cdr/progm/tptools.zip/FIRSTED.ZIP/EDUSER.PAS

Pascal/Delphi Source File | 1987-12-21 | 21KB | 729 lines

{                          EDUSER.PAS
                             ED 4.0
             Copyright (c) 1985, 87 by Borland International, Inc.            }

{$I eddirect.inc}

unit EdUser;
  {-User keyboard, prompt and error interactions}

interface

uses
  crt,                       {Basic video}
  Dos,                       {DOS calls - standard unit}
  Errors,                    {Runtime error handler}
  EdVars,                    {Global types and declarations}
  EdScrn1,                   {Fast screen writing routines}
  EdString,                  {String primitives}
  EdPtrOp,                   {Primitive pointer operations}
  EdCmds,                    {Maps keystrokes to commands}
  int24,                     {DOS critical error handler}
  Message;                   {Message system}

function EdGetInput : Char;
  {-Read next character from typeahead buffer}

function EdKeyPressed : Boolean;
  {-Determine if input is available}

function EdKeyInterrupt : Boolean;
  {-Determine whether a keystroke should interrupt background processes}

procedure EdBreathe;
  {-Stimulate typeahead routines without returning a character}

procedure EdUserPush(S : String255);
  {-Push string onto typeahead buffer}

function EdGetAnyChar : Char;
  {-Wait for and return a character from internal keyboard buffer}

procedure EdUpdateCursor;
  {-Move the cursor to the right spot}

procedure EdUpdateCmdLine;
  {-Update the message line}

procedure EdAppPromptLine(S : VarString);
  {-Append command name to message line}

procedure EdZapPromptLine;
  {-Zap message line, leaving it blank}

procedure EdResetPromptLine;
  {-Clear partial command indicator from command line}

procedure EdWritePromptLine(S : VarString);
  {-Write a new message line to the screen}

procedure EdDisplayCommandBuffer;
  {-Indicate that a partial command has been entered}

procedure EdDisplayPromptWindow(Msg : VarString; Yp : Integer; OKset : Charset; var Ch : Char);
  {-Display a one line message, and wait for char to clear it}

procedure EdErrormsg(Msgno : Integer);
  {-Write error message and dump typeahead buffer}

procedure EdAskforEditor(Xp, Yp, XSize, MaxLen : Byte; HaveWindow : Boolean; var Rs : VarString);
  {-Perform line editing functions for string input}

procedure EdAskfor(Prompt : VarString; Xp, Yp, Wid : Byte; var Rs : VarString);
  {-Edit and return a string}

function EdYesNo(Prompt : VarString) : Boolean;
  {-Return True for Yes, False for No}

function EdGetnumber(Prompt : VarString; Default : Integer) : Integer;
  {-Prompt for and return a number, 0 if invalid or empty}
  {-Plus or minus in input strings return results relative to default}

procedure EdSetNumber(var Num; Msg, Min, Max : Integer; var Empty : Boolean);
  {-Prompt for and set an integer value in range min..max}

procedure EdWait;
  {-Display a Wait signal}

  {==========================================================================}

implementation

const
  DefTypeahead = 256;        {Capacity of typeahead buffer}

type
  CircularBuffer = array[0..DefTypeahead] of Char;

var
  Circbuf : CircularBuffer;  {Our keyboard buffer}
  Circin : Integer;          {Pointer to put data into CircBuf}
  Circout : Integer;         {Pointer to take data out of CircBuf}
  AskforInsertflag : Boolean; {Insert mode state in prompt boxes}

  function EdGetInput : Char;
    {-Read next character from typeahead buffer}

  begin                      {EdGetinput}
    if EditUsercommandInput > 0 then
      Dec(EditUsercommandInput);
    EdGetInput := Circbuf[Circout];
    Circout := Succ(Circout) mod DefTypeahead;
  end;                       {EdGetinput}

  function EdKeyPressed : Boolean;
    {-Determine if input is available}
  var
    Counter : Integer;
    Ch : Char;

    procedure EdAbort;
      {-Abort command and delete typeahead buffer's contents}

    begin                    {EdAbort}
      if not(Aborting) then begin
        Aborting := True;
        Abortcmd := False;
        EdErrormsg(37);
        Abortcmd := True;
        Aborting := False;
      end;
    end;                     {EdAbort}

  begin                      {EdKeypressed}

    {Transfer keystrokes from BIOS to our keyboard buffer}
    Counter := 0;
    while (Counter < 6) and (Succ(Circin) mod DefTypeahead <> Circout) and KeyPressed do begin
      Inc(Counter);
      Ch := ReadKey;
      if (Ch = AbortChar) and (AbortEnable or (EditUsercommandInput <> 0)) then
        EdAbort
      else begin
        Circbuf[Circin] := Ch;
        Circin := Succ(Circin) mod DefTypeahead;
      end;
    end;

    EdKeyPressed := (Circin <> Circout);
  end;                       {EdKeypressed}

  function EdKeyInterrupt : Boolean;
    {-Determine whether to interrupt background process}

  begin                      {EdKeyInterrupt}
    if (IntrFlag <> Interr) then
      EdKeyInterrupt := False
    else if (Circin <> Circout) then
      EdKeyInterrupt := True
    else
      EdKeyInterrupt := EdKeyPressed;
  end;                       {EdKeyInterrupt}

  procedure EdBreathe;
    {-Enable keyboard buffering without returning a character}
  var
    B : Boolean;

  begin                      {EdBreathe}
    B := EdKeyPressed;
  end;                       {EdBreathe}

  procedure EdUserPush(S : String255);
    {-Push string onto typeahead buffer}
  var
    I : Integer;

    procedure EdPushTypeahead(Ch : Char);
      {-Push character onto front of typeahead buffer}

    begin                    {EdPushTypeahead}
      if Succ(Circin) mod DefTypeahead = Circout then
        EdErrormsg(21)
      else begin
        Circout := Pred(Circout+DefTypeahead) mod DefTypeahead;
        Circbuf[Circout] := Ch;
      end
    end;                     {EdPushTypeahead}

  begin                      {EdUserpush}
    for I := Length(S) downto 1 do
      EdPushTypeahead(S[I]);
    EditUsercommandInput := EditUsercommandInput+Length(S);
  end;                       {EdUserpush}

  {***}
  function EdGetAnyChar : Char;
    {-Wait for and return a character from internal keyboard buffer}

  begin                      {EdGetAnyChar}
    while not(EdKeyPressed or Abortcmd) do
      ;
    if not(Abortcmd) then
      EdGetAnyChar := EdGetInput;
  end;                       {EdGetAnyChar}

  {***}
  procedure EdGotoxy(C, R : Byte);
    {-Move the cursor to the specified row and column}

  begin                      {EdGotoxy}
    {Keep the hardware cursor positioned}
    GoToXY(C, R);
  end;                       {EdGotoxy}

  {***}
  procedure EdSetInsertMode(Inserting : Boolean);
    {-Keep the cursor appearance and BIOS keyboard flag up to date}
  var
    BiosKbdFlag : Byte absolute $0040 : $0017;

  begin                      {EdSetInsertMode}
    if Inserting then begin
      EdSetCursor(BigCursor);
      BiosKbdFlag := BiosKbdFlag or $80;
    end else begin
      EdSetCursor(CursorType);
      BiosKbdFlag := BiosKbdFlag and $7F;
    end;
  end;                       {EdSetInsertMode}

  {***}
  procedure EdUpdateCursor;
    {-Move the cursor to the right spot}

  begin                      {EdUpdateCursor}
    with CurWin^ do begin
      {Position cursor within a window}
      EdSetInsertMode(InsertFlag);
      EdGotoxy(Succ(ColNo-LeftEdge+LeftCol), Pred(FirstTextNo+LineNo));
    end;
    UpdateCursor := False;
  end;                       {EdUpdateCursor}

  procedure EdUpdateCmdLine;
    {-Update the top command line}

  begin                      {EdUpdateCmdLine}
    Move(PromptLine[1], Tline, PhyScrCols);
    FillChar(Aline, PhyScrCols, ScreenAttr[CmdColor]);
    EdWrline(PromptRow);
  end;                       {EdUpdateCmdLine}

  procedure EdAppPromptLine(S : VarString);
    {-Append command name to message line}

  begin                      {EdAppPromptLine}
    if Length(S) > 0 then begin
      Move(S[1], PromptLine[PromptCol], Length(S));
      PromptCol := PromptCol+Length(S);
      EdGotoxy(PromptCol, PromptRow);
    end;
  end;                       {EdAppPromptLine}

  procedure EdZapPromptLine;
    {-Zap message line, leaving it blank}

  begin                      {EdZapPromptLine}
    FillChar(PromptLine[1], PhyScrCols, Blank);
    {Reset the next column number}
    PromptCol := 1;
    UpdateCursor := True;
  end;                       {EdZapPromptLine}

  procedure EdResetPromptLine;
    {-Clear partial command indicator from command line}

  begin                      {EdResetPromptLine}
    CmdPtr := 0;
    EdZapPromptLine;
    UpdateScreen := True;
    UpdateCursor := True;
  end;                       {EdResetPromptLine}

  procedure EdWritePromptLine(S : VarString);
    {-Write a new message line to the screen}

  begin                      {EdWritePromptLine}
    EdZapPromptLine;
    EdAppPromptLine(S);
    EdUpdateCmdLine;
  end;                       {EdWritePromptLine}

  procedure EdDisplayCommandBuffer;
    {-Indicate that a partial command has been entered}
  var
    Cmd : VarString;
    I : Integer;
    Ch : Char;

  begin                      {EdDisplayCommandBuffer}
    {Get out fast if other keys are waiting}
    if (Circin = Circout) then begin
      I := 1;
      Cmd := '';
      while I <= CmdPtr do begin
        Ch := CmdBuf[I];
        case Ch of
          #0 :
            begin
              {Don't try to interpret extended keystrokes}
              Inc(I);
              Cmd := Cmd+'+';
            end;
          #1..#31 :
            Cmd := Cmd+'^'+Chr(Ord(Ch)+64)
        else
          Cmd := Cmd+Ch;
        end;
        Inc(I);
      end;
      EdWritePromptLine(Cmd);
    end;
  end;                       {EdDisplayCommandBuffer}

  {***}
  procedure EdDisplayPromptWindow(Msg : VarString; Yp : Integer; OKset : Charset; var Ch : Char);
    {-Display a one line message, and wait for char to clear it}

  begin                      {EdDisplayPromptWindow}
    {Write message to top line}
    EdWritePromptLine(Msg);

    {Wait for a key in OKset}
    repeat
      Ch := EdControlFilter(EdGetAnyChar);
    until Abortcmd or (Ch in OKset);
  end;                       {EdDisplayPromptWindow}

  {***}
  procedure EdErrormsg(Msgno : Integer);
    {-Write error message and dump typeahead buffer}
  var
    Ch : Char;

  begin                      {EdErrormsg}
    {Zap typeahead buffer before read}
    Circin := Circout;
    {Clear any pushed characters}
    EditUsercommandInput := 0;
    {Set error flag to be polled as needed by calling routines}
    GotError := True;
    {Show the message}
    EdDisplayPromptWindow(EdGetMessage(Msgno)+'-'+EdGetMessage(305), 1, [#27], Ch);
    {Clear typeahead buffer again}
    Circin := Circout;
    UpdateCursor := True;
    EdZapPromptLine;
  end;                       {EdErrormsg}

  procedure EdAskforEditor(Xp, Yp, XSize, MaxLen : Byte; HaveWindow : Boolean; var Rs : VarString);
    {-Perform line editing functions for string input}
  const
    Del = #127;
  var
    Wp : Byte;
    Ws : VarString;
    Ch : Char;
    Quitting, FirstRead : Boolean;

    function EdReadChar : Char;
      {-Read a character and convert extended keystrokes to single char}
    const
      WScommands : string[11] = ^@^A^D^F^G^B^E^S^V^X^Y;
      ExCommands : string[10] = 'sMtSGOKRwu';
    var
      Ch : Char;

    begin                    {EdReadchar}
      {Wait for a key to enter the typeahead buffer}
      Ch := EdGetAnyChar;
      if Abortcmd then
        Exit;

      if (Ch = Null) then begin
        {Get an extended character}
        Ch := EdGetAnyChar;
        {Convert IBM keypad to equivalent control char}
        Ch := WScommands[Succ(Pos(Ch, ExCommands))];
      end;
      EdReadChar := Ch;
    end;                     {EdReadchar}

    procedure EdDisplayString(S : VarString; Start : Byte);
      {-Display the working string starting at position start}
    var
      I, X, Clr : Byte;
      Ch : Char;

    begin                    {EdDisplayString}
      if not(HaveWindow) then
        Exit;
      X := Xp+Start;
      for I := Start to Length(S) do begin
        {Display the string, converting control characters to highlighted uppercase}
        Ch := S[I];
        if Ch < Blank then begin
          Clr := CtrlAttr;
          Ch := Chr(Ord(Ch)+64);
        end else
          Clr := ScreenAttr[CmdColor];
        EdFastWrite(Ch, Yp, X, Clr);
        Inc(X);
      end;
      {Clear the rest of the line}
      Clr := ScreenAttr[CmdColor];
      Ch := Blank;
      while X < Pred(Xp+XSize) do begin
        EdFastWrite(Ch, Yp, X, Clr);
        Inc(X);
      end;
    end;                     {EdDisplayString}

    procedure EdClear(var Ws : VarString; var Wp : Byte);
      {-Clear the working string}

    begin                    {EdClear}
      EdClearString(Ws);
      Wp := 1;
      EdDisplayString(Ws, 1);
      if HaveWindow then
        GoToXY(Xp+Wp, Yp);
    end;                     {EdClear}

    procedure EdInsertCharacter(Ch : Char; var Ws : VarString; var Wp : Byte);
      {-Insert a character into the string}

    begin                    {EdInsertCharacter}
      if Length(Ws) < MaxLen then begin
        if AskforInsertflag then
          Insert(Ch, Ws, Wp)
        else if Wp > Length(Ws) then
          Ws := Ws+Ch
        else
          Ws[Wp] := Ch;
        EdDisplayString(Ws, Wp);
        Inc(Wp);
      end else if not(AskforInsertflag) and (Wp <= Length(Ws)) then begin
        Ws[Wp] := Ch;
        EdDisplayString(Ws, Wp);
      end;
    end;                     {EdInsertCharacter}

  begin                      {EdAskforEditor}

    {Get working copy of the input string}
    Ws := Copy(Rs, 1, MaxLen);
    Wp := Succ(Length(Ws));

    {Display the initial string}
    EdDisplayString(Ws, 1);
    FirstRead := True;
    Quitting := False;

    repeat

      {Update the cursor}
      if HaveWindow then begin
        GoToXY(Xp+Wp, Yp);
        EdSetInsertMode(AskforInsertflag);
      end;

      {Get the next keyboard character}
      Ch := EdReadChar;
      if Abortcmd then
        {Get out of here}
        Ch := ^[;

      if FirstRead then begin
        if (Ch = ^P) or (Ch > ^Z) then
          {Clear the default string}
          EdClear(Ws, Wp);
        FirstRead := False;
      end;

      case Ch of

        ^@ :                {Null key}
          ;

        ^M :                 {Enter, accept string and exit}
          Quitting := True;

        ^[ :                 {Escape, clear string and exit}
          begin
            EdClear(Ws, Wp);
            Quitting := True;
            Abortcmd := True;
          end;

        ^B :                 {Begin of line}
          Wp := 1;

        ^E :                 {End of line}
          Wp := Succ(Length(Ws));

        ^Y :                 {Clear to end of line}
          begin
            Ws := Copy(Ws, 1, Pred(Wp));
            EdDisplayString(Ws, 1);
          end;

        ^X :                 {Clear line}
          EdClear(Ws, Wp);

        ^R :                 {Restore line to default}
          begin
            Ws := Copy(Rs, 1, MaxLen);
            Wp := Succ(Length(Ws));
            EdDisplayString(Ws, 1);
          end;

        ^S :                 {Cursor left one}
          if Wp > 1 then
            Dec(Wp);

        ^D :                 {Cursor right one}
          if Wp <= Length(Ws) then
            Inc(Wp);

        ^A :                 {Cursor left one word}
          if Wp > 1 then begin
            Dec(Wp);
            while (Wp >= 1) and ((Wp > Length(Ws)) or (Ws[Wp] = Blank)) do
              Dec(Wp);
            while (Wp >= 1) and (Ws[Wp] <> Blank) do
              Dec(Wp);
            Inc(Wp);
          end;

        ^F :                 {Cursor right one word}
          if Wp <= Length(Ws) then begin
            Inc(Wp);
            while (Wp <= Length(Ws)) and (Ws[Wp] <> Blank) do
              Inc(Wp);
            while (Wp <= Length(Ws)) and (Ws[Wp] = Blank) do
              Inc(Wp);
          end;

        ^G :                 {Delete current character}
          if Wp <= Length(Ws) then begin
            Delete(Ws, Wp, 1);
            EdDisplayString(Ws, Wp);
          end;

        ^H, Del :            {Delete character left}
          if Wp > 1 then begin
            Dec(Wp);
            Delete(Ws, Wp, 1);
            EdDisplayString(Ws, Wp);
          end;

        ^P :                 {Accept control character}
          EdInsertCharacter(Chr(Ord(EdReadChar) and $1F), Ws, Wp);

        ^V :                 {Toggle insert mode}
          AskforInsertflag := not(AskforInsertflag);

      else
        {Insert normal character}
        if Ch > ^Z then
          EdInsertCharacter(Ch, Ws, Wp);
      end;

    until Quitting;

    {Return the working string}
    Rs := Ws;

  end;                       {EdAskforEditor}

  {*** xp and yp are ignored in FirstEd}
  procedure EdAskfor(Prompt : VarString; Xp, Yp, Wid : Byte; var Rs : VarString);
    {-Edit and return a string}
  var
    Width : Byte;
    HaveWindow : Boolean;

  begin                      {EdAskFor}

    if Abortcmd then
      Exit;
    AbortEnable := True;

    if EditUsercommandInput = 0 then begin
      {Not in a macro, update the screen}
      EdWritePromptLine(Prompt);
      HaveWindow := True;
    end else
      {Don't waste time on screen within macros}
      HaveWindow := False;

    {Truncate widths that won't fit on screen}
    if Wid > PhyScrCols-Length(Prompt) then
      Width := PhyScrCols-Length(Prompt)
    else
      Width := Wid;

    {Perform the edit, returning a new string Rs}
    EdAskforEditor(Succ(Length(Prompt)), 1, Width, Width-2, HaveWindow, Rs);

    if HaveWindow then begin
      {Put the screen back in shape}
      EdUpdateCursor;
      EdWritePromptLine('');
    end;

  end;                       {EdAskfor}

  procedure EdString2integer(Src : VarString; var Result : Integer);
    {-Convert string to integer}
    {-Note 0 returned may mean ERROR - also check GotError}
  var
    V, Code : Integer;

  begin                      {EdString2integer}
    Val(Src, V, Code);
    if Code = 0 then
      Result := V
    else begin
      Result := 0;
      EdErrormsg(36);
    end;
  end;                       {EdString2integer}

  {***}
  function EdYesNo(Prompt : VarString) : Boolean;
    {-Return True for Yes, False for No}
  var
    Ch : Char;

  begin                      {EdYesNo}
    AbortEnable := True;
    EdDisplayPromptWindow(Prompt, 1, [^Y, ^N, #27], Ch);
    EdYesNo := (Ch = ^Y);
    if Ch = #27 then
      AbortCmd := true;
  end;                       {EdYesNo}

  function EdGetnumber(Prompt : VarString; Default : Integer) : Integer;
    {-Prompt for and return a number, 0 if invalid or empty}
    {-Plus or minus in input strings return results relative to default}
  var
    St : VarString;
    Result : Integer;
    PlusPos, MinusPos : Byte;

  begin                      {EdGetnumber}
    Str(Default, St);
    EdAskfor(Prompt, 1, 1, 30, St);

    if Abortcmd or EdStringEmpty(St) then
      Result := 0
    else begin

      {Check for relative indicators}
      PlusPos := Pos('+', St);
      if PlusPos <> 0 then
        Delete(St, PlusPos, 1);
      MinusPos := Pos('-', St);
      if MinusPos <> 0 then
        Delete(St, MinusPos, 1);

      {Convert string to number}
      EdString2integer(St, Result);

      if Result > 0 then begin
        {Apply relative offsets}
        if PlusPos <> 0 then
          Result := Default+Result
        else if MinusPos <> 0 then
          Result := Default-Result;
      end;

    end;
    EdGetnumber := Result;

  end;                       {EdGetNumber}

  {***}
  procedure EdSetNumber(var Num; Msg, Min, Max : Integer; var Empty : Boolean);
    {-Prompt for and set an integer value}
  var
    Number : Integer absolute Num;
    St : VarString;
    Temp : Integer;

  begin                      {EdSetNumber}
    with CurWin^ do begin
      Empty := False;
      Str(Number, St);
      EdAskfor(EdGetMessage(Msg), 1, 1, 10, St);
      if Abortcmd then
        Exit;
      if EdStringEmpty(St) then begin
        Empty := True;
        Exit;
      end;
      EdString2integer(St, Temp);
      if (Temp >= Min) and (Temp <= Max) then
        Number := Temp;
    end;
  end;                       {EdSetNumber}

  procedure EdWait;
    {-Display a Wait signal}
  begin                      {EdWait}
    EdWritePromptLine(EdGetMessage(327));
  end;                       {EdWait}

begin
  {Assure break checking is off}
  CheckBreak := False;
  {No buffered keystrokes}
  Circin := 0;
  Circout := 0;
  {Command line editor starts in insert mode}
  AskforInsertflag := True;
end.