home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBT41S1.ZIP / EDITSTRI.MOD < prev    next >
Encoding:
Text File  |  1988-02-25  |  19.7 KB  |  477 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*          Edit_String  -- Edit a string using keypad keys                 *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. FUNCTION Edit_String( VAR In_Str      : AnyStr;
  6.                           Buffer_Len  : INTEGER;
  7.                           Start_X     : INTEGER;
  8.                           X           : INTEGER;
  9.                           Y           : INTEGER;
  10.                           MaxWidth    : INTEGER;
  11.                           Force_Case  : BOOLEAN;
  12.                           Status_Line : INTEGER  ) : CHAR;
  13.  
  14. (*--------------------------------------------------------------------------*)
  15. (*                                                                          *)
  16. (*     Function:  Edit_String                                               *)
  17. (*                                                                          *)
  18. (*     Purpose:   Provides for editing a string using keypad keys.          *)
  19. (*                                                                          *)
  20. (*     Callling Sequence:                                                   *)
  21. (*                                                                          *)
  22. (*        Ch := Edit_String( VAR  In_Str     : AnyStr;                      *)
  23. (*                                Buffer_Len : INTEGER;                     *)
  24. (*                                Start_X    : INTEGER;                     *)
  25. (*                                X          : INTEGER;                     *)
  26. (*                                Y          : INTEGER;                     *)
  27. (*                                MaxWidth   : INTEGER;                     *)
  28. (*                                Force_Case : BOOLEAN;                     *)
  29. (*                                Status_Line: INTEGER ) : CHAR;            *)
  30. (*                                                                          *)
  31. (*           In_Str      --- String to be edited                            *)
  32. (*           Buffer_Len  --- Maximum length allowed for In_Str              *)
  33. (*           Start_X     --- Column to display string                       *)
  34. (*           X           --- Initial edit position in string                *)
  35. (*           Y           --- Row to display string                          *)
  36. (*           MaxWidth    --- Maximum width of display field for string      *)
  37. (*                           being edited -- horizontal scrolling will be   *)
  38. (*                           used if necessary.                             *)
  39. (*           Force_Case  --- TRUE to force input to upper case              *)
  40. (*           Status_Line --- Display edit status on this line if > 0;       *)
  41. (*                           else no status line display.                   *)
  42. (*           Ch          --- Character terminating edit of line             *)
  43. (*                                                                          *)
  44. (*     Calls:    DUPL                                                       *)
  45. (*               GoToXY                                                     *)
  46. (*               UpCase                                                     *)
  47. (*               PibTerm_KeyPressed                                         *)
  48. (*               Substr                                                     *)
  49. (*               INSERT                                                     *)
  50. (*               DELETE                                                     *)
  51. (*               Read_Kbd_Old                                               *)
  52. (*               MsDos                                                      *)
  53. (*               Stuff_Kbd_Buf                                              *)
  54. (*                                                                          *)
  55. (*     Remarks:                                                             *)
  56. (*                                                                          *)
  57. (*        Here is a list of the control characters used (including IBM PC   *)
  58. (*        function keys):                                                   *)
  59. (*                                                                          *)
  60. (*        ^A   Move back 1 word, nondestructive [Ctrl-LeftArrow]            *)
  61. (*        ^B   Save current buffer in undo buffer                           *)
  62. (*        ^C   End of input; accept what is currently visible [Ctrl-Break]  *)
  63. (*        ^D   Move forward one [RightArrow]                                *)
  64. (*        ^F   Move forward 1 word [Ctrl-RightArrow]                        *)
  65. (*        ^G   Delete character forward [DEL]                               *)
  66. (*        ^H   Move back 1, destructive (same as ASCII DEL) [BackSpace]     *)
  67. (*        ^J   End of input; accept entire buffer [Ctrl-Enter]              *)
  68. (*        ^L   Look for char: reads a character, advances cursor to match   *)
  69. (*        ^M   End of input; accept text [Enter]                            *)
  70. (*        ^P   Accept next character as-is (control character prefix)       *)
  71. (*        ^Q   Move to beginning of line, nondestructive [Home]             *)
  72. (*        ^R   Move to end of line [End]                                    *)
  73. (*        ^S   Move back 1, nondestructive [LeftArrow]                      *)
  74. (*        ^T   Delete line forward [Ctrl-End]                               *)
  75. (*        ^U   Copy undo buffer into current buffer (undo)                  *)
  76. (*        ^V   Insert on/off [INS]                                          *)
  77. (*        ^Y   Delete line                                                  *)
  78. (*        DEL  Move back 1, destructive (same as ^H) (ASCII DEL) [Ctrl-BS]  *)
  79. (*        ESC  End of input; set result to null string and return.          *)
  80. (*                                                                          *)
  81. (*--------------------------------------------------------------------------*)
  82.  
  83. TYPE
  84.    Edit_Record = RECORD
  85.                     BufLen : BYTE;
  86.                     S      : AnyStr;
  87.                  END;
  88.  
  89. CONST
  90.    ESC = ^[                        (* Escape character *);
  91.    DEL = #$7F                      (* Delete character *);
  92.  
  93. (* STRUCTURED *) CONST
  94.                                    (* Terminator characters *)
  95.  
  96.    TermChars : CharSet = [^C,^E,^J,^K,^M,^N,^[,^X];
  97.  
  98.                                    (* Legal chars in a 'word' *)
  99.  
  100.    WordChars : CharSet = ['0'..'9','A'..'Z','a'..'z'];
  101.  
  102. VAR
  103.    Insert_Mode  : BOOLEAN           (* TRUE = insert mode, FALSE = overwrite *);
  104.    WasChar      : BOOLEAN           (* TRUE if non-editing character         *);
  105.    ReDraw       : BOOLEAN           (* TRUE to redraw line being edited      *);
  106.    Ch           : CHAR              (* Current input editing character       *);
  107.    In_Str_Undo  : AnyStr            (* Undo buffer                           *);
  108.    In_String    : AnyStr            (* Working copy of string to be edited   *);
  109.    I            : INTEGER           (* General loop counter                  *);
  110.    L            : INTEGER           (* String length                         *);
  111.    LOld         : INTEGER           (* String length before current edit     *);
  112.    Regs         : Registers         (* For calling DOS function $0a          *);
  113.    My_String    : Edit_Record       (* Edit record for DOS $0a editing       *);
  114.    X2           : INTEGER           (* X position in searches                *);
  115.    Disp_Length  : INTEGER           (* # of columns available for display    *);
  116.    Left_X       : INTEGER           (* Current leftmost column displayed     *);
  117.    First_Edit   : BOOLEAN           (* TRUE if first time editing string     *);
  118.    Escape_Seen  : BOOLEAN           (* TRUE if escape sequence seen          *);
  119.  
  120. (*--------------------------------------------------------------------------*)
  121.  
  122. PROCEDURE Update_Edit_Status;
  123.  
  124. VAR
  125.    SaveX: INTEGER;
  126.    SaveY: INTEGER;
  127.  
  128. BEGIN (* Update_Edit_Status *)
  129.  
  130.    TextColor     ( Global_BackGround_Color );
  131.    TextBackGround( Global_ForeGround_Color );
  132.  
  133.    SaveX := WhereX;
  134.    SaveY := WhereY;
  135.  
  136.    GoToXY( 1 , Status_Line );
  137.  
  138.    WRITE(' Line ',Y:3,'   Column ',X:3);
  139.  
  140.    IF Insert_Mode THEN
  141.       WRITE('  Insert   ')
  142.    ELSE
  143.       WRITE('  Overwrite');
  144.  
  145.    TextColor     ( Global_ForeGround_Color );
  146.    TextBackGround( Global_BackGround_Color );
  147.  
  148.    ClrEol;
  149.  
  150.    GoToXY( SaveX, SaveY );
  151.  
  152. END   (* Update_Edit_Status *);
  153.  
  154. (*--------------------------------------------------------------------------*)
  155.  
  156. BEGIN (* Edit_String *)
  157.                                    (* Use DOS function $0a if requested *)
  158.    IF Use_Dos_Buffer_In THEN
  159.       BEGIN
  160.                                    (* Construct record for DOS $0a use  *)
  161.          WITH My_String DO
  162.             BEGIN
  163.                S                        := In_Str;
  164.                S[ SUCC( LENGTH( S ) ) ] := ^M;
  165.                BufLen                   := 254;
  166.             END;
  167.                                    (* Move to position to display string *)
  168.          GoToXY( Start_X , Y );
  169.                                    (* Stuff F3 in keyboard buffer so string *)
  170.                                    (* is displayed.                         *)
  171.  
  172.          Stuff_Kbd_Buf( F3 SHL 8 , TRUE );
  173.  
  174.                                    (* Call DOS to do the editing.           *)
  175.          WITH Regs DO
  176.             BEGIN
  177.  
  178.                AH := $0A;
  179.                DS := SEG( My_String.BufLen );
  180.                DX := OFS( My_String.BufLen );
  181.  
  182.                MsDos( Regs );
  183.  
  184.             END;
  185.  
  186.          Edit_String := ^M;               (* Return the terminator *)
  187.          In_Str      := My_String.S;      (* Return updated string *)
  188.  
  189.          EXIT;
  190.  
  191.       END;
  192.                                    (* Initialize -- not using DOS $0a *)
  193.  
  194.    Insert_Mode  := Edit_Insert_Mode;
  195.    First_Edit   := Insert_Mode AND ( Start_X = X );
  196.  
  197.                                    (* Set cursor to block if overstrike *)
  198.    IF ( NOT Insert_Mode ) THEN
  199.       IF ( Font8x8Loaded OR ( Current_Video_Mode <> 7 ) ) THEN
  200.          CursorSet( $0107 )
  201.       ELSE
  202.          CursorSet( $010D );
  203.                                    (* Display the string to be edited *)
  204.    In_String   := In_Str;
  205.    In_Str_Undo := In_Str;
  206.  
  207.    GoToXY( Start_X , Y );
  208.  
  209.    LOld        := LENGTH( In_String );
  210.    Left_X      := Start_X;
  211.  
  212.    WRITE( COPY( In_String, 1, MIN( LOld , MaxWidth ) ) );
  213.  
  214.    GoToXY( X , Y );
  215.                                    (* Display status line if requested *)
  216.    IF ( Status_Line > 0 ) THEN
  217.       Update_Edit_Status;
  218.                                    (* Begin main edit/input loop *)
  219.    REPEAT
  220.                                    (* Get current string length *)
  221.  
  222.       LOld   := LENGTH( In_String );
  223.  
  224.                                    (* Assume no need to redraw  *)
  225.       ReDraw := FALSE;
  226.                                    (* Read input character *)
  227.       Read_Kbd_Old( Ch );
  228.                                    (* Convert to upper case if requested *)
  229.       IF Force_Case THEN
  230.          Ch := UpCase( Ch );
  231.                                    (* Assume editing char found *)
  232.       WasChar := FALSE;
  233.                                    (* No escape character yet *)
  234.       Escape_Seen := FALSE;
  235.                                    (* Check for keypad keys *)
  236.       IF ( Ch = ESC ) THEN
  237.          IF PibTerm_KeyPressed THEN
  238.             BEGIN
  239.  
  240.                Escape_Seen := TRUE;
  241.  
  242.                Read_Kbd_Old( Ch );
  243.  
  244.                CASE ORD( Ch ) OF
  245.  
  246.                   Ctrl_L_Arrow : Ch := ^A;      (* Ctrl-LeftArrow  *)
  247.                   R_Arrow      : Ch := ^D;      (* RightArrow      *)
  248.                   Ctrl_R_Arrow : Ch := ^F;      (* Ctrl-RightArrow *)
  249.                   Del_Key      : Ch := ^G;      (* DEL             *)
  250.                   GlobType.Home: Ch := ^Q;      (* Home            *)
  251.                   End_Key      : Ch := ^R;      (* END             *)
  252.                   L_Arrow      : Ch := ^S;      (* LeftArrow       *)
  253.                   Ctrl_End_Key : Ch := ^T;      (* Ctrl-END        *)
  254.                   Ins_Key      : Ch := ^V;      (* INS             *)
  255.                   U_Arrow      : Ch := ^E;      (* Up-arrow        *)
  256.                   D_Arrow      : Ch := ^X;      (* Down-arrow      *)
  257.                   PgUp         : Ch := ^U;      (* PgUp            *)
  258.                   PgDn         : Ch := ^Y;      (* PgDn            *)
  259.                   ELSE           Ch := '?';     (* all unknowns    *)
  260.                                  Menu_Beep;
  261.  
  262.                END (* CASE *);
  263.             END
  264.          ELSE
  265.             BEGIN
  266.                ReDraw       := TRUE;
  267.                In_String    := '';
  268.                X            := Start_X;
  269.             END;
  270.                                    (* Perform editing function *)
  271.       CASE Ch OF
  272.                                    (* Move to beginning of string *)
  273.          ^Q: X := Start_X;
  274.                                    (* Restart editing *)
  275.          ^U: BEGIN
  276.                 In_String := In_Str_Undo;
  277.                 X         := Start_X;
  278.                 ReDraw    := TRUE;
  279.              END;
  280.  
  281.          ^Y: BEGIN
  282.                 In_String    := '';
  283.                 X            := Start_X;
  284.                 ReDraw       := TRUE;
  285.              END;
  286.                                    (* Move one word to left *)
  287.          ^A: BEGIN
  288.                 X2 := X - Start_X;
  289.                 WHILE ( ( X2 > 0 ) AND
  290.                         ( NOT ( In_String[X2] IN WordChars ) ) ) DO
  291.                     DEC( X2 );
  292.                 IF ( X2 > 0 ) THEN DEC( X2 );
  293.                 WHILE ( ( X2 > 0 ) AND ( In_String[X2] IN WordChars ) ) DO
  294.                    DEC( X2 );
  295.                 X := Start_X + X2;
  296.              END;
  297.                                    (* Save edited string in undo string *)
  298.  
  299.          ^B:  In_Str_Undo := In_String;
  300.  
  301.                                    (* Move 1 column to right *)
  302.  
  303.          ^D : IF (X - Start_X) < Buffer_Len THEN
  304.                  IF ( ( X - Start_X ) < LOld ) THEN
  305.                     INC( X );
  306.  
  307.                                    (* Move 1 word to right *)
  308.          ^F:  BEGIN
  309.                  X2 := SUCC( X - Start_X );
  310.                  L  := LENGTH( In_String );
  311.                  IF ( X2 < L ) THEN INC( X2 );
  312.                  WHILE ( ( X2 <= L ) AND
  313.                          ( In_String[X2] IN WordChars ) ) DO INC( X2 );
  314.                  WHILE ( ( X2 <= L ) AND
  315.                          ( NOT ( In_String[X2] IN WordChars ) ) ) DO INC( X2 );
  316.                  X := PRED( Start_X + X2 );
  317.               END;
  318.                                    (* Search for character *)
  319.          ^L:  BEGIN
  320.                  Read_Kbd_Old( Ch );
  321.                  L  := LOld;
  322.                  X2 := X - Start_X + 2;
  323.                  WHILE ( ( X2 <= L ) AND
  324.                          ( In_String[X2] <> Ch ) ) DO INC( X2 );
  325.                  IF ( X2 <= L ) THEN
  326.                     X := PRED( Start_X + X2 );
  327.                  Ch := ^L;
  328.               END;
  329.                                    (* Move to end of string *)
  330.          ^R,
  331.          ^N,
  332.          ^J:  X := Start_X + LOld;
  333.  
  334.                                    (* Delete character under cursor *)
  335.          ^G: BEGIN
  336.                 DELETE( In_String, X - PRED( Start_X ), 1 );
  337.                 ReDraw := TRUE;
  338.              END;
  339.                                    (* Destructive backspace *)
  340.          ^H,
  341.         DEL: IF ( X > Start_X ) THEN
  342.                 BEGIN
  343.                    DELETE( In_String, X - Start_X, 1 );
  344.                    DEC( X );
  345.                    ReDraw := TRUE;
  346.                 END;
  347.                                    (* Non-destructive backspace *)
  348.  
  349.          ^S: IF ( X > Start_X ) THEN DEC( X );
  350.  
  351.                                    (* Get control character *)
  352.          ^P: BEGIN
  353.                 Read_Kbd_Old( Ch );
  354.                 WasChar := TRUE;
  355.              END;
  356.                                    (* Delete to end of line *)
  357.  
  358.          ^T: BEGIN
  359.                 DELETE( In_String, X - PRED( Start_X ), LOld );
  360.                 ReDraw := TRUE;
  361.              END;
  362.                                    (* Toggle Insert/Overwrite Mode *)
  363.  
  364.          ^V: BEGIN
  365.                 Insert_Mode := NOT Insert_Mode;
  366.                 IF ( NOT Insert_Mode ) THEN
  367.                    IF ( Font8x8Loaded OR ( Current_Video_Mode <> 7 ) ) THEN
  368.                       CursorSet( $0107 )
  369.                    ELSE
  370.                       CursorSet( $010D )
  371.                 ELSE
  372.                    CursorOn;
  373.              END;
  374.  
  375.          ELSE
  376.              WasChar := NOT ( Ch IN TermChars ) AND
  377.                         NOT ( Escape_Seen AND ( Ch = '?' ) );
  378.  
  379.       END (* CASE *);
  380.                                    (* Ordinary character -- check if *)
  381.                                    (* string must be extended.       *)
  382.       IF WasChar THEN
  383.          IF First_Edit THEN
  384.             BEGIN
  385.                In_String    := Ch;
  386.                X            := SUCC( Start_X );
  387.                ReDraw       := TRUE;
  388.             END
  389.          ELSE IF ( X - Start_X ) >= LOld THEN
  390.             BEGIN
  391.                In_String := In_String + Ch;
  392.                IF( ( X - Start_X ) < MaxWidth ) THEN
  393.                   BEGIN
  394.                      GoToXY( X , Y );
  395.                      WRITE( Ch );
  396.                   END
  397.                ELSE
  398.                   ReDraw    := TRUE;
  399.                IF ( X - Start_X ) < Buffer_Len THEN
  400.                   INC( X );
  401.             END
  402.          ELSE
  403.                                    (* If insert mode ... *)
  404.             IF Insert_Mode THEN
  405.                BEGIN
  406.  
  407.                   INSERT( Ch, In_String,
  408.                           X - PRED( Start_X ) );
  409.  
  410.                   In_String := COPY( In_String, 1, Buffer_Len );
  411.  
  412.                   IF ( X - Start_X ) < Buffer_Len THEN
  413.                      INC( X );
  414.  
  415.                   ReDraw := TRUE;
  416.  
  417.                END
  418.             ELSE
  419.                BEGIN   (* If Overwrite mode ... *)
  420.  
  421.                   In_String[ X - PRED( Start_X ) ] := Ch;
  422.  
  423.                   GoToXY( X , Y );
  424.                   WRITE( Ch );
  425.  
  426.                   IF ( X - Start_X ) < Buffer_Len THEN
  427.                      INC( X );
  428.  
  429.                END;
  430.                                    (* Not first character edited any more *)
  431.       First_Edit := FALSE;
  432.                                    (* Set up horizontal scroll if needed *)
  433.  
  434.       L          := LENGTH( In_String );
  435.       I          := Left_X;
  436.  
  437.       IF ( SUCC( X - Left_X ) > MaxWidth ) THEN
  438.          WHILE ( SUCC( X - Left_X ) > MaxWidth ) DO
  439.             INC( Left_X )
  440.       ELSE
  441.          WHILE ( X < Left_X ) DO
  442.             DEC( Left_X );
  443.  
  444.       ReDraw := ReDraw OR ( I <> Left_X );
  445.  
  446.                                    (* Redraw line if needed *)
  447.       IF ReDraw THEN
  448.          BEGIN
  449.             GoToXY( Start_X , Y );
  450.             L := MIN( ( Left_X - Start_X + L ), MaxWidth );
  451.             CursorOff;
  452.             WRITE( COPY( In_String, SUCC( Left_X - Start_X ), L ) );
  453.             L := SUCC( WhereX - Start_X );
  454.             WHILE ( ( L <= MaxWidth ) AND ( Y = WhereY ) ) DO
  455.                BEGIN
  456.                   WRITE( ' ' );
  457.                   INC( L );
  458.                END;
  459.             CursorOn;
  460.          END;
  461.                                    (* Update status line *)
  462.  
  463.       GoToXY( ( X - Left_X + Start_X ) , Y );
  464.  
  465.       IF ( Status_Line > 0 ) THEN
  466.          Update_Edit_Status;
  467.  
  468.    UNTIL ( ( Ch IN TermChars ) AND ( NOT WasChar ) );
  469.  
  470.    Edit_String := Ch;                       (* Return the terminator *)
  471.    In_Str      := In_String;                (* Return updated string *)
  472.  
  473.                                             (* Reset underline cursor *)
  474.    CursorOn;
  475.  
  476. END   (* Edit_String *);
  477.