Programmer's ROM - The Computer Language Library

home *** CD-ROM | disk | FTP | other *** search

/ Programmer's ROM - The Computer Language Library / programmersrom.iso / ada / edit / ed2.src < prev next >

Wrap

Text File | 1988-05-03 | 72.7 KB | 2,129 lines

:::::::::: ED2.ADA :::::::::: -------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : EDITOR (ALED - Ada Line Editor) -- Version : 2.1 -- Author : Richard Conn -- : Texas Instruments -- : PO Box 801, MS 8007 -- : McKinney, TX 75069 -- DDN Address : RCONN at SIMTEL20 -- Copyright : (c) 1984, 1985 Richard Conn -- Date created : 9 Nov 84 -- Release date : 5 Dec 84 -- Last update : 15 Feb 85 -- Machine/System Compiled/Run on : DG MV 10000, ROLM ADE -- : All system-specific features are isolated in -- : the package SYSDEP, so I believe -- : that the editor is transportable between a -- : a wide variety of environments; I encountered -- : a number of "surprises" when I programmed the -- : editor, and I don't know if they were caused -- : by the ROLM ADE implementation of TEXT_IO or if -- : they were intentional; see the documentation -- -* --------------------------------------------------------------- -- -* -- Keywords : EDITOR ----------------: LINE-ORIENTED EDITOR ----------------: INPUT-LINE EDITOR -- -- Abstract : ALED - Ada Line Editor ----------------: A Line-Oriented File Editor Written in Ada ----------------: by Richard Conn ----------------: ----------------: ALED is designed to edit text files. Upon invocation, ----------------: ALED prompts the user for a file name. If the file ----------------: exists, its contents (lines) are read in and prepared ----------------: for editing; if the file does not exist, the file is ----------------: created and the empty buffer is prepared for editing. ----------------: ALED is an interactive editor, accepting single-char ----------------: commands, filling in a command prompt (for more info ----------------: as needed), and performing its functions in real-time ----------------: while the user watches. The functions provided include ----------------: (but are not limited to) the following: ----------------: ----------------: * List Lines ----------------: * Insert a Group of Lines into the Edit Buffer ----------------: * Delete Lines ----------------: * String Search and String Substitution ----------------: * Movement Within the Edit Buffer ----------------: * Reading in a File After a Specified Line ----------------: * Writing out a Range of Lines to a File ----------------: * Built-in, online Documentation (Summary) ----------------: ----------------: ALED's design includes an input line editor, which allows ----------------: the user to edit text as he types it. I was surprised ----------------: NOT to find such a basic function available in TEXT_IO. ----------------: Did I miss something? ----------------: ----------------: ALED is divided into the following files. The order ----------------: in which they are listed is the compilation order. ----------------: ----------------: SIMTEL20 Ada Package/Procedure Comments ----------------: ----------------: SYSDEP.ADA sysdep Components library ----------------: of single-character ----------------: I/O routines ----------------: ----------------: LIST.ADA generic_list Components library ----------------: of linked-list routines ----------------: ----------------: ED-SPT.ADA edit_support Visible section ----------------: of editor support ----------------: package (which contains ----------------: a few basic routines, ----------------: such as the input line ----------------: editor) ----------------: ----------------: ED-SPTB.ADA edit_support Body of editor support ----------------: package ----------------: ----------------: ED-WRK.ADA edit_worker Visible seciton of ----------------: workhorse routines ----------------: for the editor; ----------------: all major editor ----------------: functions and their ----------------: related support ----------------: routines are here ----------------: (such as list lines) ----------------: ----------------: ED-WRKB.ADA edit_worker Body of editor ----------------: workhorse routines ----------------: ----------------: ED.ADA editor Mainline of ALED ----------------: ----------------: -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 12/5/84 1.0 Richard Conn Initial Release -- 1/21/85 2.0 Richard Conn Production version -- 2/15/85 2.1 Richard Conn Minor bug fix -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This prologue must be included in all copies of this software. -- -- This software is copyright by the author. -- -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- -- -- MAIN BODY OF ALED -- Ada Line Editor -- Program Written by Richard Conn, TI Ada Technology Branch -- Completion Date: 12/5/84 -- Completion Date of 2.0: 1/31/85 -- Completion Date of 2.1: 2/15/85 -- -- -- The following packages are used throughout the editor and constitute -- a set of basic support functions. -- with TEXT_IO, EDIT_SUPPORT, EDIT_WORKER; use EDIT_SUPPORT, EDIT_WORKER; -- -- This is the main body of the editor -- procedure EDITOR is package NUM_IO is new TEXT_IO.INTEGER_IO (NATURAL); VERSION_NUMBER : constant := 21; -- major=2, minor=1 EDIT_FILE : LINE_STRING; FILE_NAME_LENGTH : NATURAL; NEW_STRING : LINE_STRING; SSTRING : LINE_STRING; DONE : BOOLEAN; RESP_CHAR, CMD_CHAR : CHARACTER; -- -- HELP_SUMMARY prints a summary of commands to the user -- procedure HELP_SUMMARY is begin NEW_LINE; NEW_LINE; PUT ("--- Movement Commands --- "); PUT ("----- Enter Lines -----"); NEW_LINE; PUT (" + Advance N Lines "); PUT (" A Append after <line> "); NEW_LINE; PUT (" - Back Up N Lines "); PUT (" I Insert before <line>"); NEW_LINE; PUT (" F Find <string> in <range>"); PUT (" "); NEW_LINE; PUT (" J Jump to <line> "); PUT ("----- Print Lines -----"); NEW_LINE; PUT (" N Find Next <string> "); PUT (" . Print Current Line "); NEW_LINE; PUT ("----- Delete Command ----- "); PUT (" < Print Next Line "); NEW_LINE; PUT (" D Delete lines in <range> "); PUT (" > Print Next Line "); NEW_LINE; PUT (" "); PUT (" L List over <range> "); NEW_LINE; PUT ("---- Help and Exits ---- "); PUT (" "); NEW_LINE; PUT (" H This Help Text "); PUT ("---- Substitution ---- "); NEW_LINE; PUT (" Q Quit without Updating "); PUT (" S String Substitute "); NEW_LINE; PUT (" X Exit and Update "); PUT (" over <range> "); NEW_LINE; NEW_LINE; PUT ("---- File Get/Put ---- "); PUT ("-- Miscellaneous -- "); NEW_LINE; PUT (" G Get <file> after <line> "); PUT (" ? Print Statistics "); NEW_LINE; PUT (" P Put <file> over <range> "); PUT (" "); NEW_LINE; NEW_LINE; PUT ("<Range>: % %,%"); NEW_LINE; PUT ("First or Second Entries --"); NEW_LINE; PUT (" #-Number, .-Current, C-Current, F-First,"); PUT (" L-Last"); NEW_LINE; PUT ("Singular Entries --"); NEW_LINE; PUT (" A-All, P-Page"); NEW_LINE; end HELP_SUMMARY; -- -- HELP prints help information to the user -- procedure HELP (INCHAR : CHARACTER) is begin NEW_LINE; case INCHAR is when 'c' | 'C' => PUT ("Command Names:"); NEW_LINE; PUT ("+ (Advance) - (Backup) . (Current)"); NEW_LINE; PUT ("< (Previous) > (Next) ? (Statistics)"); NEW_LINE; PUT ("Append Delete Find Get Help Insert"); NEW_LINE; PUT ("Jump List Next Put Quit Substitute"); NEW_LINE; PUT ("X(Exit)"); NEW_LINE; when 'n' | 'N' => PUT ("Number Values:"); NEW_LINE; PUT (". or C Current Line"); NEW_LINE; PUT (" F First Line"); NEW_LINE; PUT (" L Last Line"); NEW_LINE; PUT (" 25 Absolute Line Number"); NEW_LINE; PUT ("+7 or -5 Relative Line Number"); NEW_LINE; PUT (" A All Lines in File (only one argument)"); NEW_LINE; PUT (" P Next Page of Lines (only one argument)"); NEW_LINE; when 's' | 'S' => HELP_SUMMARY; when others => null; end case; end HELP; -- -- The mainline of the editor -- begin INITIALIZE_EDIT; -- initialize the Worker Functions CONSOLE_INIT; -- initialize the console -- PUT ("ALED - Ada Line Editor by Richard Conn, Version "); NUM_IO.PUT (VERSION_NUMBER / 10, 2); PUT ("."); NUM_IO.PUT (VERSION_NUMBER mod 10, 1); NEW_LINE; -- -- Enter File Name and Trap All Exceptions as File Name Errors -- loop begin PUT ("File Name? "); EDIT_FILE := INPUT_LINE; SSTRING := EDIT_FILE; -- initial value for SSTRING FILE_NAME_LENGTH := EDIT_FILE'LAST; for I in 1 .. EDIT_FILE'LAST loop if EDIT_FILE (I) = ASCII.NUL then FILE_NAME_LENGTH := I - 1; exit; end if; end loop; READ_FILE (EDIT_FILE (1 .. FILE_NAME_LENGTH), TRUE); exit; -- no exceptions raised exception when others => NEW_LINE; PUT ("File Name Error -- "); end; end loop; -- NUM_IO.PUT (LAST_LINE, 5); PUT (" Lines in File"); -- COMMAND_GOTO (1); -- position at first line NEW_LINE; PUT (" Type H for Help"); DONE := FALSE; -- this flag indicates when the editor is to be exited NEW_LINE; -- loop begin exit when DONE; -- -- Print Prompt to User and Get Single-Char Command -- NUM_IO.PUT (CURRENT_LINE, 5); PUT ("> "); CMD_CHAR := GETCH; -- input command character without echo -- -- Process Single-Char Commands -- case CMD_CHAR is -- -- Null Commands (Just Echo New Line) -- when ASCII.CR | ASCII.DEL | ASCII.BS => NEW_LINE; -- -- Print Current Line -- when '.' => NEW_LINE; -- no prompt LINE_START := CURRENT_LINE; -- list lines over current line LINE_STOP := CURRENT_LINE; COMMAND_LIST; -- -- Backup and Print Previous Line -- when '<' => NEW_LINE; -- no prompt if CURRENT_LINE >= 1 then -- trap errors BACKUP_LINE; end if; LINE_START := CURRENT_LINE; -- list current line LINE_STOP := LINE_START; COMMAND_LIST; -- -- Advance and Print Next Line -- when '>' => NEW_LINE; -- no prompt if CURRENT_LINE < LAST_LINE then -- trap errors ADVANCE_LINE; end if; LINE_START := CURRENT_LINE; -- list current line LINE_STOP := LINE_START; COMMAND_LIST; -- -- Advance N Lines -- when '+' => PUT ("Advance N Lines <line count>"); RANGE_INPUT; -- pay attention to 1st value if CURRENT_LINE + LINE_START <= LAST_LINE then COMMAND_GOTO (CURRENT_LINE + LINE_START); else COMMAND_GOTO (LAST_LINE); end if; -- -- Backup N Lines -- when '-' => PUT ("Back Up N Lines <line count>"); RANGE_INPUT; -- pay attention to 1st value if CURRENT_LINE - LINE_START < 1 then COMMAND_GOTO (1); else COMMAND_GOTO (CURRENT_LINE - LINE_START); end if; -- -- Print Status Info -- when '?' => NEW_LINE; -- no prompt PUT (" Edit File Name: "); OUTPUT_LINE (EDIT_FILE); NEW_LINE; PUT (" "); NUM_IO.PUT (LAST_LINE, 5); PUT (" Lines in File"); NEW_LINE; -- -- Append a Group of Lines after the Indicated Line -- when 'a' | 'A' => PUT ("Append after <line>"); RANGE_INPUT; -- 1 or 2 args used if not BLANK_INPUT then -- abort if no input COMMAND_GOTO (LINE_START); COMMAND_APPEND; end if; -- -- Delete a Group of Lines -- when 'd' | 'D' => PUT ("Delete lines in <range>"); RANGE_INPUT; -- 1 or 2 args used if not BLANK_INPUT then -- abort if no input COMMAND_DELETE; end if; -- -- Find the First Occurrance of a String over a Range of Lines -- when 'f' | 'F' => PUT ("Find <string> "); SSTRING := INPUT_LINE; PUT (" over <range>"); RANGE_INPUT; -- abort if no range input if not BLANK_INPUT then COMMAND_FIND (SSTRING); LINE_START := CURRENT_LINE; LINE_STOP := LINE_START; COMMAND_LIST; end if; -- -- Load File into Current File After Indicated Line -- when 'g' | 'G' => PUT ("Get <file> "); SSTRING := INPUT_LINE; if not BLANK_INPUT then -- abort if no input PUT (" after <line>"); RANGE_INPUT; if not BLANK_INPUT then COMMAND_GET (SSTRING); end if; end if; -- -- Print Help Message -- when 'h' | 'H' => PUT ("Help on the Following:"); NEW_LINE; PUT (" "); PUT ("C - Command Names, N - Numbering, S - Summary > "); RESP_CHAR := GETCH_WITH_ECHO; HELP (RESP_CHAR); -- help routine above -- -- Insert a Group of Lines Before the Indicated Line -- when 'i' | 'I' => PUT ("Insert before <line>"); RANGE_INPUT; if not BLANK_INPUT then -- abort if no input COMMAND_GOTO (LINE_START); COMMAND_INSERT; end if; -- -- Jump to a line -- when 'j' | 'J' => PUT ("Jump to <line>"); RANGE_INPUT; if not BLANK_INPUT then -- abort if no input COMMAND_GOTO (LINE_START); end if; -- -- List a Group of Lines Over a Range -- when 'l' | 'L' => PUT ("List Lines in <range>"); RANGE_INPUT; if not BLANK_INPUT then -- abort if no input COMMAND_LIST; end if; -- -- Find Next Occurrance of String -- when 'n' | 'N' => PUT ("Next Occurrance of <string> "); NEW_STRING := INPUT_LINE; -- get string if BLANK_INPUT then -- if no input NEW_STRING := SSTRING; -- use old string end if; LINE_START := CURRENT_LINE + 1; -- start at next line LINE_STOP := LAST_LINE; if LINE_START > LINE_STOP then LINE_START := LINE_STOP; end if; SSTRING := NEW_STRING; -- set old string COMMAND_FIND (SSTRING); -- search LINE_START := CURRENT_LINE; -- mark place and print LINE_STOP := LINE_START; COMMAND_LIST; -- -- Write a Group of Lines Out to a File -- when 'p' | 'P' => PUT ("Put <file> "); SSTRING := INPUT_LINE; if not BLANK_INPUT then -- abort if no input PUT (" over <range>"); RANGE_INPUT; if not BLANK_INPUT then COMMAND_PUT (SSTRING); end if; end if; -- -- Quit -- Exit Editor and Throw Away Contents -- when 'q' | 'Q' => PUT ("Quit without File Update (Y/N)? "); RESP_CHAR := GETCH_WITH_ECHO; if RESP_CHAR = 'y' or RESP_CHAR = 'Y' then DONE := TRUE; end if; NEW_LINE; -- CRLF is good, indicates activity -- -- Substitute One String for Another Over a Range -- when 's' | 'S' => PUT ("Substitute for Old <string> "); SSTRING := INPUT_LINE; if not BLANK_INPUT then -- abort if no input PUT (" New <string> "); NEW_STRING := INPUT_LINE; PUT (" over <range>"); RANGE_INPUT; if not BLANK_INPUT then COMMAND_SUBSTITUTE (SSTRING, NEW_STRING); end if; end if; -- -- Exit Editor and Update File -- when 'x' | 'X' => PUT ("Exit and Update File (Y/N)? "); RESP_CHAR := GETCH_WITH_ECHO; if RESP_CHAR = 'y' or RESP_CHAR = 'Y' then DONE := TRUE; end if; NEW_LINE; -- CRLF shows activity -- -- Invalid Command -- when others => PUT ("Error"); NEW_LINE; end case; -- -- Exception Handlers -- exception when RANGE_ERROR => NEW_LINE; when others => NEW_LINE; PUT (" Unknown Error Trapped"); NEW_LINE; -- end; -- command body -- end loop; -- -- Write File on Exit -- if CMD_CHAR = 'x' or CMD_CHAR = 'X' then LINE_START := 1; -- write file on way out LINE_STOP := LAST_LINE; COMMAND_PUT (EDIT_FILE); end if; -- CONSOLE_DEINIT; -- deinitialize the console -- end EDITOR; :::::::::: ED2-SPT.ADA :::::::::: -- -- PACKAGE edit_support -- by Richard Conn, TI Ada Technology Branch -- Version 1.0, 9 Nov 84 -- Version 2.0, 29 Jan 85 -- Version 2.1, 15 Feb 85 -- -- EDIT_SUPPORT provides a group of low-level support routines -- for the editor. These are basic routines which can be used -- by programs other than the editor. -- with GENERIC_LIST, TEXT_IO; package EDIT_SUPPORT is -- -- The following establishes the basic set of types, objects, -- and linked-list manipulation and numeric I/O routines. -- LINE_LENGTH : constant := 256; -- allow 256 chars/line subtype LINE_STRING is STRING (1 .. LINE_LENGTH); package LINE_LIST is new GENERIC_LIST (ELEMENT_OBJECT => LINE_STRING); package NAT_IO is new TEXT_IO.INTEGER_IO (NATURAL); -- -- The following are global values which are set by the low-level -- support routines. -- -- -- BLANK_INPUT is set by the input line editor INPUT_LINE. -- If the line just input contained nothing but space characters -- (ie, is a blank line), INPUT_LINE sets BLANK_LINE to TRUE. -- Else, BLANK_LINE is FALSE. -- BLANK_INPUT : BOOLEAN := TRUE; -- -- VALID_NUMBER is set by the string-to-natural conversion routine -- CONVERT_TO_NUMBER. If the string passed in does not begin with -- a valid digit character ('0' to '9'), VALID_NUMBER is set to FALSE -- and the value of 0 is returned by CONVERT_TO_NUMBER. Else, -- VALID_NUMBER is set to TRUE and the converted number is returned. -- VALID_NUMBER : BOOLEAN := FALSE; -- -- CTN_INDEX is set by the caller of CONVERT_TO_NUMBER to tell it -- where to begin the conversion. This number is the index -- of the first character at which to begin conversion. On exit, -- CTN_INDEX is the index of the character at which conversion was -- halted. -- CTN_INDEX : NATURAL; -- -- The following are the workhorse routines of this package. -- -- -- These routines initialize and deinitialize the -- console. They should be called at the beginning and at -- the end of the edit session. -- procedure CONSOLE_INIT; procedure CONSOLE_DEINIT; -- -- INPUT_LINE is a function which provides an input line editor. -- It accepts characters from the user until an end-of-line -- character is received, at which point INPUT_LINE terminates and -- returns an object of type LINE_STRING to the caller. INPUT_LINE -- allows simple editing of the input text as it is typed, permitting -- the user to delete previous characters, delete input entered so -- far, retype the line as entered so far, and quote a character for -- literal input. INPUT_LINE will not permit the limit of the input -- buffer to be exceeded. -- -- BLANK_LINE is set to TRUE if only blank characters are -- contained in the line. -- -- The following constants may be changed as desired: -- -- Constant Meaning -- EDIT_DEL_CHAR Delete previous character in buffer -- EDIT_DEL_LINE Restart buffer entry -- EDIT_RETYPE_LINE Retype input line as entered so far -- EDIT_QUOTE Quote following character -- function INPUT_LINE return LINE_STRING; -- -- Return next char without echo -- Return next char with echo if >= ' ' and < DEL -- function GETCH return CHARACTER; function GETCH_WITH_ECHO return CHARACTER; -- -- Provides put string routine -- procedure PUT (INSTR : STRING); -- -- Echo CRLF -- procedure NEW_LINE; -- -- OUTPUT_LINE is a procedure which outputs an object of type -- LINE_STRING to the user's terminal. Tab expansion is supported, -- and no trailing nulls are output. -- procedure OUTPUT_LINE (STR : LINE_STRING); -- -- CONVERT_TO_NUMBER accepts as input an object of type -- LINE_STRING and converts the ASCII characters starting at -- the global index CTN_INDEX to a natural number. The value -- of this number is returned, and CTN_INDEX is updated to -- indicate the index of the character which stopped the number -- scan. -- -- VALID_NUMBER is set to TRUE if the first character is an -- ASCII digit character ('0' to '9'); VALID_NUMBER is set to -- FALSE if the first character is not a digit -- -- CTN_INDEX is returned with the index of the character which -- stopped the scan/conversion process. -- function CONVERT_TO_NUMBER (STR : LINE_STRING) return NATURAL; end EDIT_SUPPORT; :::::::::: ED2-SPTB.ADA :::::::::: -- -- Package body EDIT_SUPPORT -- Written by Richard Conn, TI Ada Technology Branch -- Version 2.0, Date 31 Jan 85 -- Version 2.1, Date 15 Feb 85 -- with SYSDEP; package body EDIT_SUPPORT is -- -- Editor constants -- EDIT_DEL_CHAR : constant CHARACTER := ASCII.DEL; EDIT_DEL_LINE : constant CHARACTER := ASCII.NAK; EDIT_RETYPE_LINE : constant CHARACTER := ASCII.DC2; EDIT_QUOTE : constant CHARACTER := '\'; TAB_SIZE : constant NATURAL := 8; -- for indenting -- -- Initialize console -- procedure CONSOLE_INIT is begin SYSDEP.OPEN_CONSOLE; end CONSOLE_INIT; -- -- Deinitialize console -- procedure CONSOLE_DEINIT is begin SYSDEP.CLOSE_CONSOLE; end CONSOLE_DEINIT; -- -- PRINTING_CHARACTER indicates if the character presented to it is printable -- (ie, occupies a position on the screen) -- function PRINTING_CHARACTER (INCHAR : CHARACTER) return BOOLEAN is begin if INCHAR >= ' ' and INCHAR < ASCII.DEL then return TRUE; else return FALSE; end if; end PRINTING_CHARACTER; -- -- INPUT_LINE is the input line editor -- Customization can be done via the constant declarations -- function INPUT_LINE return LINE_STRING is WORK_LINE : LINE_STRING; INCHAR : CHARACTER; INDEX : NATURAL; POSITION : NATURAL; procedure BACKUP is -- erase previous character from display begin SYSDEP.PUT (ASCII.BS); SYSDEP.PUT (' '); SYSDEP.PUT (ASCII.BS); end BACKUP; procedure BACKUP_CHARACTER is -- backup over last char w/tab processing INCHAR : CHARACTER; BACKUP_POSITION : NATURAL; begin INCHAR := WORK_LINE (INDEX); -- extract target character if INCHAR = ASCII.HT then -- back up over tab -- compute position prior to this tab POSITION := 1; for I in 1 .. INDEX - 1 loop if WORK_LINE (I) /= ASCII.HT then POSITION := POSITION + 1; else POSITION := POSITION + 1; while POSITION mod TAB_SIZE /= 1 loop POSITION := POSITION + 1; end loop; end if; end loop; -- BACKUP required number of character positions BACKUP_POSITION := POSITION; BACKUP; BACKUP_POSITION := BACKUP_POSITION + 1; while BACKUP_POSITION mod TAB_SIZE /= 1 loop BACKUP; BACKUP_POSITION := BACKUP_POSITION + 1; end loop; else -- back up over normal char if PRINTING_CHARACTER (INCHAR) then -- printing char BACKUP; POSITION := POSITION - 1; end if; end if; end BACKUP_CHARACTER; procedure STORE_CHARACTER (INCHAR : CHARACTER) is -- store char begin if INDEX < WORK_LINE'LAST then -- room for char WORK_LINE (INDEX) := INCHAR; INDEX := INDEX + 1; else -- no room SYSDEP.PUT (ASCII.BEL); -- alarm end if; end STORE_CHARACTER; begin INDEX := 1; POSITION := 1; loop SYSDEP.GET (INCHAR); exit when INCHAR = ASCII.CR; case INCHAR is when EDIT_DEL_CHAR => -- delete previous character if INDEX /= 1 then INDEX := INDEX - 1; BACKUP_CHARACTER; else SYSDEP.PUT (ASCII.BEL); end if; when EDIT_DEL_LINE => -- delete line typed so far for I in 1 .. INDEX - 1 loop INDEX := INDEX - 1; BACKUP_CHARACTER; end loop; INDEX := 1; POSITION := 1; when EDIT_RETYPE_LINE => -- retype line input so far NEW_LINE; -- next line WORK_LINE (INDEX) := ASCII.NUL; -- mark end of line OUTPUT_LINE (WORK_LINE); when EDIT_QUOTE => -- quote next char SYSDEP.PUT (EDIT_QUOTE); -- echo EDIT_QUOTE char POSITION := POSITION + 1; -- EDIT_QUOTE is printing char SYSDEP.GET (INCHAR); -- get quoted char STORE_CHARACTER (INCHAR); if PRINTING_CHARACTER (INCHAR) then SYSDEP.PUT (INCHAR); -- echo it POSITION := POSITION + 1; end if; when ASCII.HT => -- tabulate STORE_CHARACTER (INCHAR); SYSDEP.PUT (' '); POSITION := POSITION + 1; while POSITION mod TAB_SIZE /= 1 loop SYSDEP.PUT (' '); POSITION := POSITION + 1; end loop; when others => -- process next char STORE_CHARACTER (INCHAR); -- store char if PRINTING_CHARACTER (INCHAR) then SYSDEP.PUT (INCHAR); POSITION := POSITION + 1; end if; end case; end loop; NEW_LINE; -- -- NUL-fill line -- for I in INDEX .. WORK_LINE'LAST loop WORK_LINE (I) := ASCII.NUL; end loop; -- -- test for empty line and set BLANK_INPUT -- BLANK_INPUT := TRUE; for I in 1 .. INDEX loop if WORK_LINE (I) > ' ' then BLANK_INPUT := FALSE; exit; end if; end loop; -- -- return line -- return WORK_LINE; -- end INPUT_LINE; -- -- OUTPUT_LINE outputs the string input to the user's terminal. -- procedure OUTPUT_LINE (STR : LINE_STRING) is INDEX : NATURAL := 1; POSITION : NATURAL := 1; begin loop exit when STR (INDEX) = ASCII.NUL; if STR (INDEX) = ASCII.HT then -- tabulate SYSDEP.PUT (' '); POSITION := POSITION + 1; while (POSITION mod TAB_SIZE) /= 1 loop SYSDEP.PUT (' '); POSITION := POSITION + 1; end loop; else -- output character SYSDEP.PUT (STR (INDEX)); if PRINTING_CHARACTER (STR (INDEX)) then POSITION := POSITION + 1; end if; end if; INDEX := INDEX + 1; end loop; end OUTPUT_LINE; -- -- GETCH returns the next character without echo -- GETCH_WITH_ECHO returns the next character with echo if -- ' ' <= ch < DEL -- function GETCH return CHARACTER is INCHAR : CHARACTER; begin SYSDEP.GET (INCHAR); return INCHAR; end GETCH; function GETCH_WITH_ECHO return CHARACTER is INCHAR : CHARACTER; begin INCHAR := GETCH; if ' ' <= INCHAR and INCHAR < ASCII.DEL then SYSDEP.PUT (INCHAR); end if; return INCHAR; end GETCH_WITH_ECHO; -- -- PUT outputs a string -- procedure PUT (INSTR : STRING) is begin for I in 1 .. INSTR'LAST loop SYSDEP.PUT (INSTR (I)); end loop; end PUT; -- -- NEW_LINE outputs CRLF to the console -- procedure NEW_LINE is begin SYSDEP.PUT (ASCII.CR); SYSDEP.PUT (ASCII.LF); end NEW_LINE; -- -- CONVERT_TO_NUMBER converts the number represented by ASCII -- digit chars to type NATURAL and returns its value. VALID_NUMBER -- and CTN_INDEX (an I/O value) are returned as side effects. -- function CONVERT_TO_NUMBER (STR : LINE_STRING) return NATURAL is INTERNAL_VALUE : NATURAL; INDEX : NATURAL; DONE : BOOLEAN; function IS_DIGIT (IN_CHAR : CHARACTER) return BOOLEAN is begin if IN_CHAR in '0' .. '9' then return TRUE; else return FALSE; end if; end IS_DIGIT; begin INTERNAL_VALUE := 0; -- set accumulated value INDEX := CTN_INDEX; -- set start index if IS_DIGIT (STR (INDEX)) then VALID_NUMBER := TRUE; -- input is a number else VALID_NUMBER := FALSE; -- input is not valid return 0; -- return value of 0 end if; loop exit when not IS_DIGIT (STR (INDEX)); case STR (INDEX) is when '0' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 0; when '1' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 1; when '2' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 2; when '3' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 3; when '4' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 4; when '5' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 5; when '6' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 6; when '7' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 7; when '8' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 8; when '9' => INTERNAL_VALUE := INTERNAL_VALUE * 10 + 9; when others => null; -- this will not be selected end case; INDEX := INDEX + 1; end loop; CTN_INDEX := INDEX; -- return index of invalid digit return INTERNAL_VALUE; exception when others => -- any type of numeric error trapped CTN_INDEX := INDEX; -- index set VALID_NUMBER := FALSE; -- not valid return 0; -- return 0 value end CONVERT_TO_NUMBER; end EDIT_SUPPORT; :::::::::: ED2-WRK.ADA :::::::::: -- -- Package EDIT_WORKER -- Written by Richard Conn, TI Ada Technology Branch -- Version 2.0, Date 31 Jan 85 -- Version 2.1, Date 15 Feb 85 -- with TEXT_IO; with EDIT_SUPPORT; use EDIT_SUPPORT; package EDIT_WORKER is -- -- EDIT_WORKER is the set of procedures which implement the various -- commands available through the EDITOR. These are the workhorse -- routines. -- --=================================================================== -- -- The following global data buffers are used by several of the routines. -- LINE_START and LINE_STOP are the numbers of the lines indicated by -- input to RANGE_INPUT, and these values are set by RANGE_INPUT and read -- by the routines which call RANGE_INPUT. The exception RANGE_ERROR indicates -- if there is an error in the input values received from RANGE_INPUT. -- LINE_START, LINE_STOP : NATURAL; RANGE_ERROR : exception; --=================================================================== -- -- Procedure RANGE_INPUT -- -- RANGE_INPUT is used to input a range specification of the following -- forms: -- x -- reference a single line or one of the special ranges -- x,x -- reference a group of lines -- x x -- reference a group of lines (same as x,x) -- -- A single line reference may be any of the following: -- -- # -- a line number, such as 1, 245, etc -- +# -- the line which is n lines after the current line, such as +23 -- -# -- the line which is n lines before the current line, such as -45 -- A -- all lines in the file -- C -- the current line -- F -- the first line -- L -- the last line -- P -- 20 consecutive lines, starting at the current line -- -- A group of lines may be referenced by any combination of the following: -- -- # +# -# C F L -- -- If the first entry of the pair references a line which is after the -- line referenced by the second entry of the pair, then the RANGE_ERROR -- flag will be raised. -- -- EXCEPTIONS RAISED: RANGE_ERROR -- -- SIDE EFFECTS: -- The values of LINE_START and LINE_STOP are always set. If an error -- is encountered, RANGE_ERROR is raised (error message is also printed). -- procedure RANGE_INPUT; --=================================================================== -- -- The following routines return the indexes (natural numbers) of -- the current and last lines (CURRENT_LINE, LAST_LINE) and advance -- to the next line or backup to the previous line (ADVANCE_LINE, -- BACKUP_LINE) -- function CURRENT_LINE return NATURAL; function LAST_LINE return NATURAL; procedure ADVANCE_LINE; procedure BACKUP_LINE; --=================================================================== -- -- The following file read routine is used to read the initial -- file when the editor starts up -- procedure READ_FILE (FILE_NAME : STRING; CREATE_FLAG : BOOLEAN); --=================================================================== -- -- The following routines implement the indicated commands: -- -- ROUTINE NAME COMMAND MEANING OF COMMAND -- initialize_edit Initialize the Editor -- command_append A Append Lines After Current Line -- command_delete D Delete One or More Lines -- command_find F Search for String -- command_get G Read in File after Current Line -- command_goto J Jump to (Position to) Indicated Line -- command_insert I Insert Lines Before Current line -- command_list L List One or More Lines -- command_put P Write Out Range of Lines to File -- command_substitute S Substitute Strings in One or More Lines -- procedure INITIALIZE_EDIT; procedure COMMAND_APPEND; procedure COMMAND_DELETE; procedure COMMAND_FIND (STR : EDIT_SUPPORT.LINE_STRING); procedure COMMAND_GET (FILE_NAME : EDIT_SUPPORT.LINE_STRING); procedure COMMAND_GOTO (NUM : NATURAL); procedure COMMAND_INSERT; procedure COMMAND_LIST; procedure COMMAND_PUT (FILE_NAME : EDIT_SUPPORT.LINE_STRING); procedure COMMAND_SUBSTITUTE (OLD_STRING, NEW_STRING : EDIT_SUPPORT.LINE_STRING); --=================================================================== end EDIT_WORKER; :::::::::: ED2_WRKB.ADA :::::::::: -- -- Package Body of EDIT_WORKER -- by Richard Conn, Texas Instruments, Ada Technology Branch -- Version 1.0, Date 20 Nov 84 -- Version 2.0, Date 31 Jan 85 -- Version 2.1, Date 15 Feb 85 -- -- -- This package contains all of the procedures which implement -- the major commands of the editor. EDIT_WORKER is divided into -- functional sections (more or less), with each section separated -- from the others by lines like "--=============". -- -- The package is divided into the following sections: -- -- SECTION FUNCTION -- Package NUM_IO Provide numeric output for NATURAL numbers -- RANGE_INPUT Provide general-purpose line range input -- CURRENT_LINE Returns the number of the current line -- LAST_LINE Returns the number of the last line -- ADVANCE_LINE Advances to the next line -- BACKUP_LINE Back ups to the last line -- Line Output Print lines and info to the terminal -- INPUT_LINE_PROMPT -- NUMBER_PREFIX -- PREFIX_PRINT -- COMMAND_GOTO Implements the Jump (J) Command and Used Internally -- COMMAND_APPEND Implements the Append (A) Command -- COMMAND_INSERT Implements the Insert (I) Command -- COMMAND_LIST Implements the List (L) Command -- COMMAND_DELETE Implements the Delete (D) Command -- Scanning Aids Lower-level functions/procedures for Substitute -- SUB_STRING and Find -- COUNT_CHARS -- SUBSTITUTE -- COMMAND_SUBSTITUTE Implements the Substitute (S) Command -- COMMAND_FIND Implements the Find (F) Command -- GET and PUT Support Routines to Support File Input/Output -- WRITE_FLINE -- PUT_RANGE -- READ_FILE -- COMMAND_GET Implements the Get (G) Command -- COMMAND_PUT Implements the Put (P) Command -- with TEXT_IO; with EDIT_SUPPORT; use EDIT_SUPPORT; package body EDIT_WORKER is -- -- LINE_EXIT_CHAR is the character which, when it appears as the first -- character of a line and it is the only character on that line, indicates -- that the last line has been input for the Append and Insert Commands. -- LINE_EXIT_CHAR : constant CHARACTER := '.'; --=================================================================== -- Package NUM_IO -- Generic Instantiation of TEXT_IO.INTEGER_IO for NATURAL numbers -- package NUM_IO is new TEXT_IO.INTEGER_IO (NATURAL); --=================================================================== -- RANGE_INPUT inputs one or two values, and it always returns with -- LINE_START containing the first value and LINE_STOP containing the -- second. LINE_START <= LINE_STOP, and if there was any error in -- the input, the exception RANGE_ERROR is raised -- procedure RANGE_INPUT is INTERNAL_ERROR : exception; PAGE_SIZE : constant NATURAL := 20; -- number of lines/"page" RANGE_LINE : LINE_STRING; I : NATURAL; -- index of next char in input line DONE : BOOLEAN := FALSE; -- -- Local procedure FLUSH_SPACES - skip over spaces until non-space, -- including end-of-line (ASCII.nul), is encountered -- procedure FLUSH_SPACES is begin loop exit when RANGE_LINE (I) /= ' '; I := I + 1; end loop; end FLUSH_SPACES; -- -- The body of RANGE_INPUT -- begin I := 1; -- index of first char PUT (" "); -- space (prompt) RANGE_LINE := INPUT_LINE; -- input line (with editing) if BLANK_INPUT then LINE_START := LINE_LIST.CURRENT_INDEX; -- set first and last to . LINE_STOP := LINE_START; return; -- done end if; FLUSH_SPACES; -- get rid of leading spaces -- -- Check for an process the First Argument -- case RANGE_LINE (I) is -- first of one or two arguments when '+' => -- current line + offset CTN_INDEX := I + 1; -- set starting index LINE_START := LINE_LIST.CURRENT_INDEX + CONVERT_TO_NUMBER (RANGE_LINE); LINE_STOP := LINE_START; I := CTN_INDEX; -- restore index when '-' => -- current line - offset CTN_INDEX := I + 1; -- set starting index LINE_START := LINE_LIST.CURRENT_INDEX - CONVERT_TO_NUMBER (RANGE_LINE); LINE_STOP := LINE_START; I := CTN_INDEX; -- restore index when 'a' | 'A' => -- all lines LINE_START := 1; LINE_STOP := LINE_LIST.LAST_INDEX; I := I + 1; -- next char when 'c' | 'C' | '.' => -- current line LINE_START := LINE_LIST.CURRENT_INDEX; LINE_STOP := LINE_START; I := I + 1; -- next char when 'f' | 'F' => -- first line LINE_START := 1; LINE_STOP := LINE_START; I := I + 1; -- next char when 'l' | 'L' => -- last line LINE_START := LINE_LIST.LAST_INDEX; LINE_STOP := LINE_START; I := I + 1; -- next char when 'p' | 'P' => -- page LINE_START := LINE_LIST.CURRENT_INDEX; if LINE_START + PAGE_SIZE > LINE_LIST.LAST_INDEX then LINE_STOP := LINE_LIST.LAST_INDEX; else LINE_STOP := LINE_START + PAGE_SIZE; end if; I := I + 1; -- next char when '0' .. '9' => CTN_INDEX := I; LINE_START := CONVERT_TO_NUMBER (RANGE_LINE); LINE_STOP := LINE_START; I := CTN_INDEX; when others => raise INTERNAL_ERROR; end case; -- -- Check for possible range errors -- if LINE_START > LINE_LIST.LAST_INDEX then raise RANGE_ERROR; end if; if LINE_STOP > LINE_LIST.LAST_INDEX then raise RANGE_ERROR; end if; -- -- Advance to next token -- FLUSH_SPACES; -- flush spaces between entires -- -- Done if no next token -- if RANGE_LINE (I) = ASCII.NUL then return; end if; -- -- If a comma is present, a second argument is given -- if RANGE_LINE (I) = ',' then I := I + 1; FLUSH_SPACES; if RANGE_LINE (I) = ASCII.NUL then raise INTERNAL_ERROR; end if; end if; -- -- Process Second Argument of an argument pair -- The value of this argument is assigned to LINE_STOP -- case RANGE_LINE (I) is -- second of two arguments when '+' => -- current line + offset CTN_INDEX := I + 1; LINE_STOP := LINE_LIST.CURRENT_INDEX + CONVERT_TO_NUMBER (RANGE_LINE); I := CTN_INDEX; when '-' => -- current line - offset CTN_INDEX := I + 1; LINE_STOP := LINE_LIST.CURRENT_INDEX - CONVERT_TO_NUMBER (RANGE_LINE); I := CTN_INDEX; when 'c' | 'C' | '.' => -- current line LINE_STOP := LINE_LIST.CURRENT_INDEX; when 'f' | 'F' => -- first line LINE_STOP := 1; when 'l' | 'L' => -- last line LINE_STOP := LINE_LIST.LAST_INDEX; when '0' .. '9' => CTN_INDEX := I; LINE_STOP := CONVERT_TO_NUMBER (RANGE_LINE); I := CTN_INDEX; when others => raise INTERNAL_ERROR; end case; -- -- Check out possible range errors -- if LINE_STOP > LINE_LIST.LAST_INDEX then raise RANGE_ERROR; end if; -- -- Handle Exceptions Raised within the procedure RANGE_INPUT -- exception when NUMERIC_ERROR => NEW_LINE; PUT (" Numeric Value Error"); LINE_START := 0; LINE_STOP := 0; raise RANGE_ERROR; when INTERNAL_ERROR => NEW_LINE; PUT (" Range Syntax Error"); LINE_START := 0; LINE_STOP := 0; raise RANGE_ERROR; when RANGE_ERROR => NEW_LINE; PUT (" Range Value Error"); LINE_START := 0; LINE_STOP := 0; raise RANGE_ERROR; when others => NEW_LINE; PUT (" Unknown Error in RANGE_INPUT"); LINE_START := 0; LINE_STOP := 0; raise RANGE_ERROR; end RANGE_INPUT; --=================================================================== -- -- CURRENT_LINE -- This function returns the number of the current line -- function CURRENT_LINE return NATURAL is begin return LINE_LIST.CURRENT_INDEX; end CURRENT_LINE; --=================================================================== -- -- LAST_LINE -- This function returns the number of the last line -- function LAST_LINE return NATURAL is begin return LINE_LIST.LAST_INDEX; end LAST_LINE; --=================================================================== -- -- ADVANCE_LINE -- This function advances the current line by one -- procedure ADVANCE_LINE is DUMMY : BOOLEAN; begin DUMMY := LINE_LIST.CURRENT_NEXT; end ADVANCE_LINE; --=================================================================== -- -- BACKUP_LINE -- This procedure back ups the current line by one -- procedure BACKUP_LINE is DUMMY : BOOLEAN; begin DUMMY := LINE_LIST.CURRENT_PREVIOUS; end BACKUP_LINE; --=================================================================== -- -->> Procedure INPUT_LINE_PROMPT -- This procedure simply prints the prompt for the Append and Insert -- commands. -- procedure INPUT_LINE_PROMPT is begin PUT ("Enter Lines ("); TEXT_IO.PUT (LINE_EXIT_CHAR); PUT ("<RETURN> to Stop)"); NEW_LINE; end INPUT_LINE_PROMPT; -- -->> Procedure NUMBER_PREFIX -- This routine prints the prefix number ("nnnnn: ") for lines -- that are displayed or input. -- procedure NUMBER_PREFIX (NUM : NATURAL) is begin NUM_IO.PUT (INTEGER (NUM), 5); -- 5-char field PUT (": "); -- trailing prompt end NUMBER_PREFIX; -- -->> Procedure PREFIX_PRINT -- This routine prints a line prefixed by a number ("nnnnn: text"). -- procedure PREFIX_PRINT (NUM : NATURAL; STR : LINE_STRING) is begin NUMBER_PREFIX (NUM); OUTPUT_LINE (STR); end PREFIX_PRINT; --=================================================================== -- Procedure INITIALIZE_EDIT -- This procedure initializes the editor for future processing -- procedure INITIALIZE_EDIT is begin LINE_LIST.INITIALIZE_LIST; end INITIALIZE_EDIT; --=================================================================== -- Procedure COMMAND_GOTO -- This procedure positions the current line to the indicated index. -- That is, if NUM = 5, the fifth line in the file becomes the current line. -- procedure COMMAND_GOTO (NUM : NATURAL) is I : NATURAL; DUMMY : BOOLEAN; begin if NUM <= LINE_LIST.LAST_INDEX then I := NUM; else I := LINE_LIST.LAST_INDEX; end if; DUMMY := LINE_LIST.SET_CURRENT_INDEX (I); -- return code is a don't care end COMMAND_GOTO; --=================================================================== -- Procedure COMMAND_APPEND -- This procedure implements the Append command. It accepts a group of -- lines one at a time, appends the new line after the current line, makes -- the new line the current line, and continues until a line consisting of -- only a LINE_EXIT_CHAR is input. -- procedure COMMAND_APPEND is INLINE : LINE_STRING; begin INPUT_LINE_PROMPT; -- print prompt loop NUMBER_PREFIX (LINE_LIST.CURRENT_INDEX + 1); -- print number of line INLINE := INPUT_LINE; -- get input line exit when (INLINE (1) = LINE_EXIT_CHAR) and (INLINE (2) = ASCII.NUL); -- test for exit condition LINE_LIST.APPEND_ELEMENT (INLINE); -- append line after current end loop; end COMMAND_APPEND; --=================================================================== -- Procedure COMMAND_INSERT -- This procedure is like COMMAND_APPEND, but the input lines are inserted -- before the current line. -- procedure COMMAND_INSERT is INLINE : LINE_STRING; begin INPUT_LINE_PROMPT; -- print prompt loop NUMBER_PREFIX (LINE_LIST.CURRENT_INDEX); -- print line number INLINE := INPUT_LINE; -- get new line exit when (INLINE (1) = LINE_EXIT_CHAR) and (INLINE (2) = ASCII.NUL); -- test for exit condition LINE_LIST.INSERT_ELEMENT (INLINE); -- perform insertion end loop; end COMMAND_INSERT; --=================================================================== -- Procedure COMMAND_LIST -- This procedure lists a group of lines over a range. The range is -- indicated by the global variables LINE_START and LINE_STOP, which are -- set by the RANGE_INPUT routine and may be set by other routines as well. -- procedure COMMAND_LIST is I : NATURAL; DUMMY : BOOLEAN; begin COMMAND_GOTO (LINE_START); -- position at first line for I in 1 .. LINE_STOP - LINE_START + 1 loop -- over lines in range PREFIX_PRINT (LINE_LIST.CURRENT_INDEX, LINE_LIST.RETURN_CURRENT_ELEMENT); -- print line NEW_LINE; exit when not LINE_LIST.CURRENT_NEXT; -- adv to next line, check end -- of list and exit if done end loop; if LINE_STOP /= LINE_LIST.LAST_INDEX then DUMMY := LINE_LIST.CURRENT_PREVIOUS; -- back up, for we have -- gone too far end if; end COMMAND_LIST; --=================================================================== -- Procedure COMMAND_DELETE -- This procedure deletes lines over the range from LINE_START to LINE_STOP. -- This range is a pair of global values which are set by RANGE_INPUT and -- possibly by other routines. -- procedure COMMAND_DELETE is I : NATURAL; DUMMY : BOOLEAN; begin COMMAND_GOTO (LINE_START); -- position to first line for I in 1 .. LINE_STOP - LINE_START + 1 loop LINE_LIST.DELETE_ELEMENT; -- delete current line end loop; end COMMAND_DELETE; --=================================================================== -- COMMAND_SUBSTITUTE requires the following support routines, which are -- contained within this functional area. -- -- ROUTINE FUNCTION -- SUB_STRING Determine if SUB_LINE is a substring of TARGET_LINE -- starting at position START_POS -- COUNT_CHARS Count the number of characters in the passed string, -- up to but not including the terminating ASCII.nul -- SUBSTITUTE Substitute NEW_STRING for OLD_STRING in TARGET_LINE -- starting at position FOUND_LOC (which is returned -- -- -->> Function SUB_STRING -- This function scans for the string SUB_LINE in the string TARGET_LINE -- starting at the position START_POS. Both strings are character sequences -- terminated by ASCII.nul. If found, SUB_STRING returns a positive number -- which is the index in TARGET_LINE of the first character of the substring -- SUB_LINE; the procedure SUBSTITUTE may be used to actually perform the -- substitution, given this return value. If not found, SUB_STRING returns -- the number 0. -- function SUB_STRING (TARGET_LINE, SUB_LINE : LINE_STRING; START_POS : NATURAL) return NATURAL is FOUND_POS : NATURAL; TI, SI : NATURAL; ANSWER : BOOLEAN; begin -- -- This initialization could have been done in the declarations above. -- Old habits (from Pascal) are sometimes hard to break. -- TI := START_POS; -- set index in target line FOUND_POS := 0; -- initialize value to not found ANSWER := FALSE; -- ANSWER=TRUE if substring found -- -- This is the major loop of SUB_STRING. It advances through the TARGET_LINE -- one character at a time, checking to see if SUB_LINE is duplicated in -- TARGET_LINE starting at the current position. -- loop exit when TARGET_LINE (TI) = ASCII.NUL; -- done if at end of target -- -- This is the minor loop of SUB_STRING. It advances through SUB_LINE, -- comparing each character in SUB_LINE to the corresponding (relative) -- character in TARGET_LINE until either the end of SUB_LINE is reached -- (in which case the substring has been found at TI, the current position -- in TARGET_LINE) or the current character in SUB_LINE does not match -- the current character in TARGET_LINE (in which case we advance to the -- next character in TARGET_LINE and try again if the end of TARGET_LINE -- has not been reached). -- for SI in 1 .. LINE_LENGTH loop if SUB_LINE (SI) = ASCII.NUL then -- exit if complete match ANSWER := TRUE; exit; end if; exit when TARGET_LINE (TI + SI - 1) /= SUB_LINE (SI); end loop; -- -- We are now out of the preceeding FOR loop. If ANSWER is TRUE, we got here -- from the IF, which means we found a match. -- if ANSWER then FOUND_POS := TI; -- mark position in target line and ... exit; -- ... exit major loop end if; -- -- We have not matched the SUB_LINE yet; advance to the next character in -- the TARGET_LINE. -- TI := TI + 1; -- advance to next char in target line end loop; -- -- If the substring was found, FOUND_POS is non-zero. If not, FOUND_POS -- still retains its original value of zero. -- return (FOUND_POS); end SUB_STRING; -- -->> Function COUNT_CHARS -- The following function determines the number of characters in the -- string (which is terminated by an ASCII.nul) passed to it. This -- character count does not include the terminating ASCII.nul. -- function COUNT_CHARS (STR : LINE_STRING) return NATURAL is I, J, K : NATURAL; begin J := LINE_LENGTH + 1; K := 0; for I in 1 .. J loop exit when STR (I) = ASCII.NUL; K := I; end loop; return (K); -- the loop exits on the ASCII.nul exception when others => -- must have exceeded dimension of STR return (LINE_LENGTH); end COUNT_CHARS; -- -->> Procedure SUBSTITUTE -- This procedure substitutes NEW_STRING for OLD_STRING in TARGET_LINE -- starting at the position indicated by FOUND_LOC. The value of FOUND_LOC -- was determined by the routine SUB_STRING and is assumed to be correct -- (ie, OLD_STRING starts at index FOUND_LOC in TARGET_LINE). -- procedure SUBSTITUTE (TARGET_LINE : in out LINE_STRING; OLD_STRING, NEW_STRING : LINE_STRING; FOUND_LOC : in out NATURAL) is SIZE_NEW, SIZE_OLD, SIZE_TARGET : NATURAL; I, NEXT_CHAR : NATURAL; RETURN_LOC : NATURAL; TEMP_LINE : LINE_STRING; -- -- This is the mainline of SUBSTITUTE -- begin -- -- Determine sizes of the three strings -- TARGET, OLD, and NEW -- SIZE_TARGET := COUNT_CHARS (TARGET_LINE); SIZE_OLD := COUNT_CHARS (OLD_STRING); SIZE_NEW := COUNT_CHARS (NEW_STRING); -- -- Copy the TARGET_LINE up to but not including the point of substitution -- if FOUND_LOC /= 1 then TEMP_LINE (1 .. FOUND_LOC - 1) := TARGET_LINE (1 .. FOUND_LOC - 1); NEXT_CHAR := FOUND_LOC; else NEXT_CHAR := 1; end if; -- -- Append the NEW_STRING to the end of the line being built -- if SIZE_NEW /= 0 then for I in 1 .. SIZE_NEW loop TEMP_LINE (NEXT_CHAR) := NEW_STRING (I); NEXT_CHAR := NEXT_CHAR + 1; end loop; end if; -- -- Determine the index of the next character after the OLD_STRING in TARGET_LINE -- I := FOUND_LOC + SIZE_OLD; -- -- Append the characters after OLD_STRING in TARGET_LINE to the end of the -- line being built. -- loop exit when TARGET_LINE (I) = ASCII.NUL; TEMP_LINE (NEXT_CHAR) := TARGET_LINE (I); NEXT_CHAR := NEXT_CHAR + 1; I := I + 1; end loop; -- -- Fill out the rest of the line which is being built with ASCII.nul chars -- for I in NEXT_CHAR .. LINE_LENGTH loop TEMP_LINE (I) := ASCII.NUL; end loop; -- -- Replace the original TARGET_LINE with the line being built. -- Also return the position to resume the scan in the TARGET_LINE in case -- there is more than one occurrance of the substring. -- TARGET_LINE := TEMP_LINE; FOUND_LOC := FOUND_LOC + SIZE_NEW; end SUBSTITUTE; --=================================================================== -- Procedure COMMAND_SUBSTITUTE -- This procedure implements the Substitute command. The range of lines -- over which to perform the substitution is provided by RANGE_INPUT as -- the global variables LINE_START and LINE_STOP, and the string OLD_STRING -- contains the string to be substituted while the string NEW_STRING contains -- the string to substitute for OLD_STRING. -- procedure COMMAND_SUBSTITUTE (OLD_STRING, NEW_STRING : LINE_STRING) is FOUND_LOC : NATURAL; TEMP_LINE : LINE_STRING; begin COMMAND_GOTO (LINE_START); -- goto first line in range FOUND_LOC := 1; -- start at position 1 in first line -- -- Major loop for substitution. Each line is examined at least once, and, -- if a substitution is performed, the line is passed over again to see -- if the OLD_STRING occurrs in the line twice. -- loop exit when LINE_LIST.CURRENT_INDEX > LINE_STOP; -- -- See if OLD_STRING is contained in the current line. -- FOUND_LOC := SUB_STRING (LINE_LIST.RETURN_CURRENT_ELEMENT, OLD_STRING, FOUND_LOC); -- -- Replace OLD_STRING with NEW_STRING and look again after last character -- in NEW_STRING within the current line if found; reset starting position -- of search and advance to next line if not found. -- if FOUND_LOC /= 0 then TEMP_LINE := LINE_LIST.RETURN_CURRENT_ELEMENT; SUBSTITUTE (TEMP_LINE, OLD_STRING, NEW_STRING, FOUND_LOC); LINE_LIST.RETURN_CURRENT_ELEMENT.CONTENT := TEMP_LINE; PREFIX_PRINT (LINE_LIST.CURRENT_INDEX, LINE_LIST.RETURN_CURRENT_ELEMENT); NEW_LINE; else FOUND_LOC := 1; exit when not LINE_LIST.CURRENT_NEXT; end if; end loop; end COMMAND_SUBSTITUTE; --=================================================================== -- Procedure COMMAND_FIND -- This procedure implements the Find command. It searches for the passed -- string over a range of lines and stops at the first line in that range -- which contains the indicated string. LINE_START and LINE_STOP are -- global values set by RANGE_INPUT which indicate the indexes of the first -- and last lines in the range. -- -- The routine SUB_STRING is used to determine if the passed string is -- contained in the current line. -- procedure COMMAND_FIND (STR : LINE_STRING) is TEMP_LINE : LINE_STRING; I : NATURAL; begin COMMAND_GOTO (LINE_START); -- position at first line -- -- Exit when String is found, else advance to next line -- for I in LINE_START .. LINE_STOP loop TEMP_LINE := LINE_LIST.RETURN_CURRENT_ELEMENT; exit when SUB_STRING (TEMP_LINE, STR, 1) /= 0; exit when not LINE_LIST.CURRENT_NEXT; -- never hit this exit end loop; end COMMAND_FIND; --=================================================================== -- File I/O Support Routines -- -- This set of routines provides the basic support required to perform file -- input/output with the editor. These routines and their functions are: -- -- ROUTINE FUNCTION -- WRITE_FLINE Write the current line to the output file -- PUT_RANGE Write a group of lines to the output file -- READ_FILE Read a file into the edit buffer after the -- current line -- -- -->> Procedure WRITE_FLINE -- This procedure writes the current line out to the file whose descriptor -- is passed as an argument. The number of characters in the line is first -- counted, and then TEXT_IO.PUT_LINE is used to write the line. -- procedure WRITE_FLINE (LOC_FILE : TEXT_IO.FILE_TYPE) is LEN : NATURAL; begin LEN := COUNT_CHARS (LINE_LIST.RETURN_CURRENT_ELEMENT); TEXT_IO.PUT_LINE (LOC_FILE, LINE_LIST.RETURN_CURRENT_ELEMENT.CONTENT (1 .. LEN)); end WRITE_FLINE; -- -->> Procedure PUT_RANGE -- PUT_RANGE positions to the first line, indexed by START, and writes lines -- to the file via repeated calls to WRITE_FLINE until the line indexed by -- STOP is written. -- procedure PUT_RANGE (FD : TEXT_IO.FILE_TYPE; START, STOP : NATURAL) is I : NATURAL; begin COMMAND_GOTO (START); -- position at first line for I in START .. STOP loop WRITE_FLINE (FD); -- write current line exit when not LINE_LIST.CURRENT_NEXT; -- advance to next line end loop; end PUT_RANGE; -- -->> Procedure READ_FILE -- This procedure reads the file named by FILE_NAME into the edit buffer. -- If the file is not found and CREATE_FLAG is TRUE, an empty file is -- created; if the file is not found and CREATE_FLAG is FALSE, only an error -- message is issued. -- procedure READ_FILE (FILE_NAME : STRING; CREATE_FLAG : BOOLEAN) is LOC_FILE : TEXT_IO.FILE_TYPE; INLINE : LINE_STRING; LEN : NATURAL; begin -- -- Try to open the file for input. If this fails because the file is not -- found, the exception NAME_ERROR is raised. -- TEXT_IO.OPEN (LOC_FILE, TEXT_IO.IN_FILE, FILE_NAME); -- -- Append lines after the current line until the end of the input file is -- reached. -- loop exit when TEXT_IO.END_OF_FILE (LOC_FILE); TEXT_IO.GET_LINE (LOC_FILE, INLINE, LEN); for I in LEN + 1 .. LINE_LENGTH loop INLINE (I) := ASCII.NUL; end loop; LINE_LIST.APPEND_ELEMENT (INLINE); end loop; -- -- Close the Input File (generally, a good practice) -- TEXT_IO.CLOSE (LOC_FILE); -- -- Handle problems; the big problem to look for is when the file is not -- found (the exception NAME_ERROR is raised by TEXT_IO.OPEN). -- exception when TEXT_IO.NAME_ERROR => -- -- If the CREATE_FLAG is TRUE, create an empty file; else, say that file -- was not found. -- if CREATE_FLAG then TEXT_IO.CREATE (LOC_FILE, TEXT_IO.OUT_FILE, FILE_NAME); TEXT_IO.CLOSE (LOC_FILE); PUT ("New File"); NEW_LINE; else PUT ("File not Found"); NEW_LINE; end if; end READ_FILE; --=================================================================== -- Procedure COMMAND_GET -- This procedure implements the Get command. The file indicated by the -- passed FILE_NAME is read into the edit buffer after the indicated line -- (if any). -- procedure COMMAND_GET (FILE_NAME : LINE_STRING) is CURRENT_SAVE : NATURAL; DUMMY : BOOLEAN; FILE_NAME_LENGTH : NATURAL; begin FILE_NAME_LENGTH := FILE_NAME'LAST; for I in 1 .. FILE_NAME'LAST loop if FILE_NAME (I) = ASCII.NUL then FILE_NAME_LENGTH := I - 1; exit; end if; end loop; COMMAND_GOTO (LINE_START); -- position at indicated line CURRENT_SAVE := LINE_LIST.CURRENT_INDEX; -- save index of current line READ_FILE (FILE_NAME (1 .. FILE_NAME_LENGTH), FALSE); -- read file DUMMY := LINE_LIST.SET_CURRENT_INDEX (CURRENT_SAVE); -- restore current end COMMAND_GET; --=================================================================== -- Procedure COMMAND_PUT -- This procedure implements the Put command. It writes out lines over -- the range from LINE_START to LINE_STOP (input via RANGE_INPUT) to the file -- named in the passed parameter. -- procedure COMMAND_PUT (FILE_NAME : LINE_STRING) is LOC_FILE : TEXT_IO.FILE_TYPE; I : NATURAL; FILE_NAME_LENGTH : NATURAL; begin -- -- Compute length of file name -- FILE_NAME_LENGTH := FILE_NAME'LAST; for I in 1 .. FILE_NAME'LAST loop if FILE_NAME (I) = ASCII.NUL then FILE_NAME_LENGTH := I - 1; exit; end if; end loop; -- -- Delete the original file, if any -- TEXT_IO.OPEN (LOC_FILE, TEXT_IO.IN_FILE, FILE_NAME (1 .. FILE_NAME_LENGTH)); TEXT_IO.DELETE (LOC_FILE); -- -- Create the new file -- TEXT_IO.CREATE (LOC_FILE, TEXT_IO.OUT_FILE, FILE_NAME (1 .. FILE_NAME_LENGTH)); PUT_RANGE (LOC_FILE, LINE_START, LINE_STOP); TEXT_IO.CLOSE (LOC_FILE); -- -- If the original file did not already exist, the above TEXT_IO.OPEN would -- have raised the exception NAME_ERROR. The following handler traps this -- and goes ahead to create the file and write to it. -- exception when TEXT_IO.NAME_ERROR => TEXT_IO.CREATE (LOC_FILE, TEXT_IO.OUT_FILE, FILE_NAME (1 .. FILE_NAME_LENGTH)); PUT_RANGE (LOC_FILE, LINE_START, LINE_STOP); TEXT_IO.CLOSE (LOC_FILE); end COMMAND_PUT; --=================================================================== end EDIT_WORKER;