Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PASLEDIT.ZIP/EDITOR.PAS

Pascal/Delphi Source File | 1991-01-17 | 15.2 KB | 459 lines

(*
   Simple line editor program.  Written in Standard Pascal.

   By Ilya Shlyakhter, D-block
*)

PROGRAM LineEditor (Input, Output);

   USES Strings;

   CONST NameCount = 10;
         MaxNameLength = 30;

   TYPE NameArray = ARRAY [1..NameCount] OF StrType;
        NameCountType = 0..NameCount;
        NameLengthType = 0..MaxNameLength;

        Digit = 0..9;

   VAR NameData: NameArray;


   FUNCTION UpCaseChar (Ch: Char): Char;

   (*
       Converts a character to uppercase.
   *)

      BEGIN  (* UpCaseChar *)
         IF Ch IN ['a'..'z'] THEN
            Ch := Chr (Ord (Ch) - Ord ('a') + Ord ('A'));

         UpCaseChar := Ch
      END;   (* UpCaseChar *)

   FUNCTION ChrDigit (Ch: Char): Digit;

      BEGIN   (* ChrDigit *)
         ChrDigit := Ord (Ch) - Ord ('0')
      END;    (* ChrDigit *)

   PROCEDURE FlushLine;

      VAR Ch: Char;

      BEGIN  (* FlushLine *)
         WHILE NOT (Eof OR Eoln) DO
            Read (Ch);

         ReadLn
      END;   (* FlushLine *)


   PROCEDURE ReadNames (VAR Names: NameArray);

      VAR CurrentNameNum: NameCountType;

      PROCEDURE InputName (VAR Name: StrType);

         VAR CurrentCharNum: NameLengthType;
             Ch: Char;

         BEGIN  (* InputName *)
            StrInit (Name);
            CurrentCharNum := 1;

            WHILE NOT Eof AND NOT Eoln AND (CurrentCharNum <= MaxnameLength) DO
               BEGIN  (* read name *)
                  Read (Ch);
                  StrAddChar (Name, Ch);
                  CurrentCharNum := CurrentCharNum + 1
               END;   (* read name *)

            ReadLn
         END;   (* InputName *)

      BEGIN  (* ReadNames *)
         FOR CurrentNameNum := 1 TO NameCount DO
            BEGIN  (* read *)
               WriteLn;
               Write ('Please enter name #',CurrentNameNum,': ');
               InputName (Names [CurrentnameNum])
            END;   (* read *)
      END;   (* ReadNames *)


   PROCEDURE DisplayNames (Names: NameArray);

      VAR I: Integer;

      BEGIN  (* DisplayNames *)
         WriteLn;
         WriteLn ('You have entered the following names:');
         WriteLn;

         FOR I := 1 TO NameCount DO
            BEGIN
               Write (I,' - ');
               StrDisplayString (Names [I])
            END;

         WriteLn;
      END;   (* DisplayNames *)

   PROCEDURE ProcessNames (Names: NameArray);

      VAR NameNum: NameCountType;
          Done: Boolean;


      PROCEDURE EditString (VAR TheString: StrType);

         VAR Done: Boolean;
             Ch: Char;

         PROCEDURE DisplayHelp;

            VAR Ch: Char;

            BEGIN  (* DisplayHelp *)

               FlushLine;
               WriteLn;

               WriteLn ('                EDITOR COMMANDS                                                ');
               WriteLn ('                                                                               ');
               WriteLn (' Icn           Insert character c at position n                              ');
               WriteLn ('                                                                               ');
               WriteLn (' DPn           Delete character at POSITION n                                ');
               WriteLn (' DFc           Delete FIRST occurence of the character c                     ');
               WriteLn ('                                                                               ');
               WriteLn (' RPcn          Replace the character at POSITION n with character c          ');
               WriteLn (' RFcd          Replace the FIRST occurence of character c with character d ');
               WriteLn (' RAcd          Replace ALL  occurences of character c with character d     ');
               WriteLn ('                                                                               ');
               WriteLn (' H, ?          Display this help screeen                                     ');
               WriteLn (' Q             Quit                                                          ');
            END;   (* DisplayHelp *)


         PROCEDURE ReadPos (VAR Value: StrLengthType; VAR Error: Boolean);

            VAR Ch: Char;
                CurrentValue: Integer;
                Digits: SET OF Char;
                Factor: Integer;
                MaxFactor: Integer;

            BEGIN  (* ReadPos *)
               Digits := ['0'..'9'];
               Error := False;

               IF Eof OR Eoln THEN
                  Error := True
                     ELSE
                        BEGIN  (* there is text to read *)
                           CurrentValue := 0;
                           Factor := 1;

                           MaxFactor := 1;
                           WHILE (MaxStrLength DIV MaxFactor) > 0 DO
                              MaxFactor := MaxFactor * 10;


                           WHILE NOT (Eof OR Eoln OR Error OR (Factor > MaxFactor)) DO
                              BEGIN  (* process number *)
                                 Read (Ch);
                                 IF Ch IN Digits THEN
                                    CurrentValue := CurrentValue + ChrDigit (Ch) * Factor
                                       ELSE
                                          Error := True
                              END;   (* process number *)
                        END;   (* there is text to read *)

               IF NOT Error THEN
                  Value := CurrentValue

            END;   (* ReadPos *)

         PROCEDURE ReportError;

            VAR Ch: Char;

            BEGIN  (* ReportError *)

               FlushLine;
               WriteLn;
               WriteLn ('Input error. Try again.');
               WriteLn
            END;   (* ReportError *)

         PROCEDURE ProcessDelete;

            VAR Ch: Char;

            PROCEDURE ProcessDelPos;

               VAR Position: StrLengthType;
                   Error: Boolean;

               BEGIN  (* ProcessDelPos *)
                  ReadPos (Position, Error);

                  IF Error THEN
                     ReportError
                        ELSE
                           BEGIN
                              StrDeleteCharPos (TheString, Position);
                              FlushLine
                           END
               END;   (* ProcessDelPos *)

            PROCEDURE ProcessDelFirst;

               VAR Position: StrLengthType;
                   Ch: Char;

               BEGIN  (* ProcessDelFirst *)
                 IF NOT (Eof OR Eoln) THEN
                   BEGIN  (* process parameter *)
                     Read (Ch);
                     StrDeleteCharFirst (TheString, Ch);
                     FlushLine
                   END    (* process parameter *)
                     ELSE
                        ReportError;

               END;   (* ProcessDelFirst *)

            BEGIN  (* ProcessDelete *)
               IF Eof OR Eoln THEN
                  ReportError
                     ELSE
                        BEGIN
                           Read (Ch);  (* read Delete subfunction *)

                           CASE UpCaseChar (Ch) OF
                              'P': ProcessDelPos;
                              'F': ProcessDelFirst;

                              ELSE
                                 ReportError
                           END  (* case *)
                        END;

            END;   (* ProcessDelete *)

         PROCEDURE ProcessInsert;

            VAR Position: StrLengthType;
                VAR Ch: Char;
                Error: Boolean;

            BEGIN  (* ProcessInsert *)
              IF Eof OR Eoln THEN
                ReportError
                  ELSE
                     BEGIN  (* at least 1 parameter given *)
                        Read (Ch);
                        IF Eof OR Eoln THEN
                           ReportError
                              ELSE
                                 BEGIN  (* read position *)
                                    ReadPos (Position, Error);
                                    IF Error THEN
                                       ReportError
                                          ELSE
                                             BEGIN  (* everything ok *)
                                                StrInsertChar (TheString, Ch, Position);
                                                FlushLine
                                             END    (* everything ok *)
                                 END;   (* read position *)
                     END;   (* at least 1 parameter given *)

            END;   (* ProcessInsert *)

         PROCEDURE ProcessReplace;

            VAR ReplaceType: Char;

            PROCEDURE ProcessReplacePos;

               VAR Ch: Char;
                   Position: StrLengthType;
                   Error: Boolean;

               BEGIN  (* ProcessReplacePos *)
                  IF Eof OR Eoln THEN
                     ReportError
                        ELSE
                           BEGIN  (* at least 1 parameter given *)
                              Read (Ch);
                              IF Eof OR Eoln THEN
                                 ReportError
                                    ELSE
                                       BEGIN  (* at least 2 parameters given *)
                                          ReadPos (Position, Error);
                                          IF Error THEN
                                             ReportError
                                                ELSE
                                                   BEGIN  (* everything ok *)
                                                      StrReplaceCharPos (TheString, Ch, Position);
                                                      FlushLine
                                                   END    (* everything ok *)

                                       END;   (* at least 2 parameters given *)
                           END;   (* at least 1 parameter given *)
               END;   (* ProcessReplacePos *)

            PROCEDURE ProcessReplaceFirst;

               VAR OldChar, NewChar: Char;

               BEGIN  (* ProcessReplaceFirst *)
                  IF Eof OR Eoln THEN
                     ReportError
                        ELSE
                           BEGIN  (* source character given *)
                              Read (OldChar);
                              IF Eof OR Eoln THEN
                                 ReportError
                                    ELSE
                                       BEGIN  (* target character given *)
                                          Read (NewChar);
                                          StrReplaceCharFirst (TheString, OldChar, NewChar);
                                          FlushLine
                                       END    (* target character given *)
                           END;   (* source character given *)
               END;   (* ProcessReplaceFirst *)

            PROCEDURE ProcessReplaceAll;

               VAR OldChar, NewChar: Char;

               BEGIN  (* ProcessReplaceAll *)
                  IF Eof OR Eoln THEN
                     ReportError
                        ELSE
                           BEGIN  (* source character given *)
                              Read (OldChar);
                              IF Eof OR Eoln THEN
                                 ReportError
                                    ELSE
                                       BEGIN  (* target character given *)
                                          Read (NewChar);
                                          StrReplaceCharAll (TheString, OldChar, NewChar);
                                          FlushLine
                                       END    (* target character given *)
                           END;   (* source character given *)


               END;   (* ProcessReplaceAll *)

            BEGIN  (* ProcessReplace *)
              IF Eof OR Eoln THEN
                  ReportError
                     ELSE
                        BEGIN  (* there is more input to read *)
                           Read (ReplaceType);

                           CASE UpCaseChar (ReplaceType) OF

                              'P':  ProcessReplacePos;
                              'F':  ProcessReplaceFirst;
                              'A':  ProcessReplaceAll
                                 ELSE
                                    ReportError;
                           END;  (* case *)

                        END;   (* there is more input to read *)

            END;   (* ProcessReplace *)

         PROCEDURE ProcessAppend;

            VAR Ch: Char;

            BEGIN  (* ProcessAppend *)
               IF Eof OR Eoln THEN
                  ReportError
                     ELSE
                        BEGIN  (* process parameter *)
                           Read (Ch);
                           StrAddChar (TheString, Ch);
                           FlushLine
                        END;   (* process parameter *)


            END;   (* ProcessAppend *)


         BEGIN  (* EditString *)
            WriteLn;

            Done := False;

            WHILE NOT Done DO
               BEGIN  (* edit string *)
                  WriteLn;
                  StrDisplayString (TheString);
                  WriteLn ('The name is now ',StrLength (TheString),' characters long.');
                  WriteLn;
                  Write ('Enter command: ');

                  IF Eof OR Eoln THEN
                     ReportError
                        ELSE
                           BEGIN  (* the user entered something *)
                              Read (Ch);

                              CASE UpCaseChar (Ch) OF
                                 'D':  ProcessDelete;
                                 'I':  ProcessInsert;
                                 'R':  ProcessReplace;
                                 'A':  ProcessAppend;
                                 'H':  DisplayHelp;
                                 'Q':  Done := True

                              END;  (* case *)




                           END;   (* the user entered something *)


               END;   (* edit string *)


         END;   (* EditString *)

      BEGIN  (* ProcessNames *)

         Done := False;

         REPEAT
            REPEAT
               WriteLn;
               Write ('Enter the number of name to revise (1 through ',NameCount,', 0 to quit): ');
               ReadLn (NameNum);
            UNTIL NameNum <= NameCount;

            IF NameNum = 0 THEN
               Done := True
                  ELSE
                     EditString (Names [NameNum])
         UNTIL Done;

         WriteLn
      END;   (* ProcessNames *)


   BEGIN  (* LineEditor *)
      ReadNames (NameData);

      DisplayNames (NameData);
      ProcessNames (NameData)
   END.   (* LineEditor *)