MODULE Sedtmain(INPUT,OUTPUT); {Screen EDiTor} {Edit History: Anker Berg-Sonne 28-MAY-1984 13:55:51.48 Edit 6. Move marks forward when inserting at marks Anker Berg-Sonne 24-MAY-1984 09:56:31.65 Edit 5. Make routines return 1 Anker Berg-Sonne 12-APR-1984 12:24:38.92 Edit 4. Make CR Enter Anker Berg-Sonne 12-APR-1984 09:44:20.00 Edit 3. Recovery fixed Anker Berg-Sonne 4-APR-1984 17:10:44.32 Edit 2 DEC multinational character set bug fixed Anker Berg-Sonne 28-MAR-1984 10:13:37.45 Submission to DECUS library Anker Berg-Sonne 27-MAR-1984 14:18:13.43 Edit 1 Make CGC repeat Anker Berg-Sonne 26-MAR-1984 12:27:53.34 ******* Version 1.0 ********* ***** All future revisions must have *********** ***** version number updated *********** Anker Berg-Sonne 22-MAR-1984 17:00:45.59 Help from File Anker Berg-Sonne 21-MAR-1984 11:29:21.96 Sped up buffer changes Anker Berg-Sonne 20-MAR-1984 16:41:08.96 Status Display Anker Berg-Sonne 19-MAR-1984 09:32:50.92 Vt200 F17-F20 select buffers Anker Berg-Sonne 15-MAR-1984 13:27:03.39 Error with command file and recovery not working together Anker Berg-Sonne 15-MAR-1984 12:20:37.98 Erase Working... when finished Anker Berg-Sonne 27-JAN-1984 12:05:37.29 Working indicator Anker Berg-Sonne 24-JAN-1984 10:56:50.35 Move to the right of undeleted and pasted text when moving forward Anker Berg-Sonne 24-JAN-1984 09:54:26.25 Center Line and error handling of disk errors Anker Berg-Sonne 19-DEC-1983 20:46:59.36 Don't do T$Start til recover finishes Anker Berg-Sonne 17-DEC-1983 12:41:27.38 Make My_Screen save on buffer changes Anker Berg-Sonne 16-DEC-1983 13:08:29.20 Make substitute start at current position Anker Berg-Sonne 15-DEC-1983 15:53:38.90 Go back after filling Anker Berg-Sonne 30-NOV-1983 16:08:29.12 More key definitions Anker Berg-Sonne 28-NOV-1983 11:58:50.54 VT200 fixes Anker Berg-Sonne 14-NOV-1983 13:15:20.88 Updates on errors Anker Berg-Sonne 14-NOV-1983 13:15:20.88 Delete Journal file on EX Anker Berg-Sonne 14-NOV-1983 12:58:23.90 Spaces in between CR's between paragraphs Anker Berg-Sonne 11-NOV-1983 17:13:42.54 DECmate II keypad Anker Berg-Sonne 3-NOV-1983 15:08:47.71 Retmote terminal startup ***************************** 1-JUL-1983 14:57:25.50 Anker to Australia Anker Berg-Sonne 27-JUN-1983 16:54:55.39 Set Any_Changes when recover or command set Anker Berg-Sonne 24-JUN-1983 09:33:32.07 Get command implemented Anker Berg-Sonne 23-JUN-1983 13:17:37.47 Delete to EOB problem fixed Anker Berg-Sonne 23-JUN-1983 11:15:07.88 More echo fixing. I'm glad this is only a problem on GIGI's and VT52's which don't have scroll regions Anker Berg-Sonne 23-JUN-1983 10:09:08.39 Made ; comment char in command files Anker Berg-Sonne 22-JUN-1983 15:43:31.20 More fixes when echoing This is driving me nuts! Anker Berg-Sonne 22-JUN-1983 09:50:32.82 Made control W work in Help Anker Berg-Sonne 22-JUN-1983 09:44:15.08 More work on getting echoed input at the right screen position Anker Berg-Sonne 22-JUN-1983 09:37:44.85 Made empty key definition unddefine Anker Berg-Sonne 14-JUN-1983 10:13:41.15 Sped up Buf_Put_S for Sedt init. Anker Berg-Sonne 14-JUN-1983 09:19:45.62 Fixed confusion with substitute of multiple lines Anker Berg-Sonne 10-JUN-1983 10:08:37.05 Drop into echo mode after [EOB] has been pushed down Anker Berg-Sonne 8-JUN-1983 10:37:32.30 Fixes Remove_line bug and made HT echo as in Get_Input Anker Berg-Sonne 4-JUN-1983 14:13:40.46 Fixed crash when inserting a character just after deleting a on small files Anker Berg-Sonne 3-JUN-1983 08:55:40.55 Better performance in wrap mode Anker Berg-Sonne 2-JUN-1983 13:49:51.94 Don't clear the select unless it has to be or with RES Anker Berg-Sonne 27-MAY-1983 10:51:33.39 VT200 support Anker Berg-Sonne 27-MAY-1983 10:22:15.84 Purge last command from command file Anker Berg-Sonne 19-MAY-1983 11:06:34.79 Made control L insert an Anker Berg-Sonne 19-MAY-1983 10:37:49.83 Fixed bug in Opt_Close_Lines Anker Berg-Sonne 18-MAY-1983 11:36:06.73 Fixed bug in searches including Anker Berg-Sonne 17-MAY-1983 17:00:55.35 Made C_REF set application keypad Anker Berg-Sonne 17-MAY-1983 15:04:01.28 Fixed Gold B 0 bug Anker Berg-Sonne 16-MAY-1983 10:56:25.29 Made Gold D DI. Anker Berg-Sonne 6-MAY-1983 10:38:19.41 Put + in front of positive token Anker Berg-Sonne 5-MAY-1983 10:17:18.16 Program and text modes Anker Berg-Sonne 29-APR-1983 14:54:25.78 Journaling and recovery Anker Berg-Sonne 28-APR-1983 14:50:20.67 Changed Save_File to not use Move_Cursor Anker Berg-Sonne 27-APR-1983 15:33:00.78 fixed CR insert bug and fill region up to end of buffer bug Anker Berg-Sonne 27-APR-1983 11:39:22.30 Made set Word_Delim Anker Berg-Sonne 27-APR-1983 09:30:01.89 Fixed bug pushing text ahead of cursor Anker Berg-Sonne 26-APR-1983 09:53:51.30 Fixed stuttering when autowrap on Anker Berg-Sonne 7-APR-1983 15:09:19.16 VT102 Special sequences Anker Berg-Sonne 7-APR-1983 10:34:31.10 Use CR in OPT_Move_Cursor Anker Berg-Sonne 6-APR-1983 16:35:54.80 **********Field Test************** Anker Berg-Sonne 6-APR-1983 13:21:50.97 %L, %C, %M, and %P Anker Berg-Sonne 5-APR-1983 14:07:04.78 Faster move in files>Window Anker Berg-Sonne 4-APR-1983 16:48:35.89 Fixed error with save Anker Berg-Sonne 3-APR-1983 10:04:31.28 Tab stops and numeric input echo Anker Berg-Sonne 1-APR-1983 15:54:12.61 File Edit and File Output commands Anker Berg-Sonne 30-MAR-1983 17:07:06.73 Search bug fixed Anker Berg-Sonne 29-MAR-1983 17:26:49.16 Paragraph begin fixed Anker Berg-Sonne 29-MAR-1983 10:53:14.21 Long input requests Anker Berg-Sonne 29-MAR-1983 10:59:22.56 Fixed bug with insert at end of buffer Anker Berg-Sonne 25-MAR-1983 14:59:51.41 Set Ent_Count in Read_Entity Anker Berg-Sonne 25-MAR-1983 13:38:11.35 Make Read_Entity repeatable Anker Berg-Sonne 23-MAR-1983 11:46:59.20 Many changes in screen handling Anker Berg-Sonne 21-MAR-1983 09:19:47.21 Z command Anker Berg-Sonne 20-MAR-1983 16:31:34.63 Multiple buffers Anker Berg-Sonne 20-MAR-1983 14:24:50.69 General cleanup of variables Anker Berg-Sonne 16-MAR-1983 09:26:40.59 Text filling implemented Anker Berg-Sonne 15-MAR-1983 15:14:28.02 Make all files record lengths 256 and open input files read only Anker Berg-Sonne 15-MAR-1983 10:55:19.41 Control C trapping Anker Berg-Sonne 15-MAR-1983 08:25:27.81 Make Get_Input not translate control characters Anker Berg-Sonne 14-MAR-1983 13:40:03.97 Flush when going back in unmodified buffer Anker Berg-Sonne 12-MAR-1983 19:06:08.46 No Set_Scroll for non VT100's on exit Anker Berg-Sonne 12-MAR-1983 12:34:01.55 Made Pad_Adj much simpler Anker Berg-Sonne 11-MAR-1983 14:21:30.07 Fixed search bufferdestroy by key definition Anker Berg_Sonne 11-MAR-1983 10:07:42.05 Improved Vertical on tabbed data Anker Berg-Sonne 8-Mar-1983 15:40:56.83 File Include, File Save, Key Save Date Input and lots of other things Anker Berg-Sonne Mar-4-1983 Fixed OPT_Open_Lines bug Anker Berg-Sonne Mar-4-1983 Restartable SEDT working Anker Berg-Sonne Mar-4-1983 No update if typeahead Anker Berg-Sonne Mar-4-1983 OPT_Close for VT100 effieciency Anker Berg-Sonne Mar-3-1983 Made OPT_Open_Lines more clever on VT100's Anker Berg-Sonne Mar-2-1983 Did groundwork for restartable SEDT Anker Berg-Sonne Mar-1-1983 F(file) I(nclude) command Anker Berg-Sonne Mar-1-1983 Made Scan use LOCC instruction Anker Berg-Sonne Feb-28-1983 Fixed Page begin bug Anker Berg-Sonne Feb-28-1983 Fixed Search case sensitivity bug } {Program logic: Sedt is entered through two subroutines: Sedt: Used for the first call Sedtrest: Used for reentering the same edit session Sedtpurg: Must be called before the routine Sedt Sedt initializes the terminal, the internal database, reads the input file, initializes the journal file and then goes into a loop where it calls Do_Change. Sedtrest reinitializes the terminal and refreshes the screen after which it goes into the same Do_Change loop as Sedt at the end of the loop Sedt and Sedtrest both check Command, which contains the last command executed. If it's C_EX they try to save the file. If the save fails they stay in the loop. When the loop is exited they reset the terminal and exit. Do_Change reads keys from the terminal and translates them into the commands they are programmed as. There is special code at the beginning of the loop to optimize normal insertion at the beginning of the line. Each call to Get_Key returns a key type and the specific key within that type. The actual translation is done by the procedure Get_Pad. After translating a key the BOOLEAN Com_End is checked, which Get_Pad sets to TRUE if the definition is terminated by a ".". After reading up till Com_End is TRUE Com_Parse is called with the argument 1. Get_Pad moves a key definition string into the buffer Com. It checks for a "." at the end of the definition, which causes it to set Com_End to TRUE. If a ? is seen it will call Get_Input for input from the terminal. If a ! is seen it will call Get_Inkey for a keystroke to be read and the key mnemonic to be inserted. Com_Parse parses the commands in the buffer Com. The argument to Com_Parse it the position within Com that parsing should start at. An argument different from one indicates that we are inside a loop delimited with parentheses. Com_Parse gets a character at a time out of Com using Com_Ch_Get. When it has found either a valid entity, using Get_Entity, or a valid command, using Get_Command, it calls either Ex_Null or Ex_Command to have the command executed. If it sees a ) it returns to make loops work through recursive calls of Com_Parse. Seeing a ( makes it call Com_Parse recursively the number of times defined by a count preceeding the (. Com_Ch_Get gets a character out of Com. If it's a % it looks for a token name and substitutes the token value for the name. Ex_Null calls Ex_Entity which finds the position, beginning, and end of an entity. It then calls Move_Cursor, which moves the position of the cursor. Ex_Command does the actual command execution. If the command requires and entity it then calls Read_Entity which gets the entity position, beginning, and end. } CONST Maxlines=24; {Number of lines in Screen Database} Maxcol=132; {Number of columns in Screen Database} Memmax=5000; {Number of bytes in memory buffer} Blocksize=2048; {Record size of work file} Window=16384; {Size of line pointer window} Rec_Length=512; {Size of terminal buffer} Maxbuffers=5; {Maximum number of concurrent buffers} Maxmarks=10; {Maximum number os settable marks} Maxtabs=80; {Maximum number of settable tabs} Working_Toggle=3; {Number of buffer writes before Working... is flashed} TYPE Term_Types=(VT52,VT100,VK100,VT102,VT200); Edit_Body=PACKED ARRAY [1..256] OF CHAR; Character_Array=ARRAY [1..256] OF CHAR; D_Type=(Plus,Minus); Screen=ARRAY [1..Maxlines,1..Maxcol] OF CHAR; {Screen database} Screen_Info=ARRAY [1..Maxlines] OF INTEGER; {Info for screen database} String=VARYING [80] OF CHAR; {Compatibility with UCSD} S_Body=PACKED ARRAY [1..80] OF CHAR; Buf_Block=ARRAY [1..Blocksize] OF CHAR;{Work file record} Membuffer=ARRAY [1..Memmax] OF CHAR; {Memory buffer for work file} Tempfile=FILE OF Buf_Block; {Work file} Buffer= {Window} RECORD Inno, Outno, Topout: INTEGER; {Record pointers into work files} Pos, Bufsize, Memsize, Memstart, Memptr: INTEGER; Modified, Flip: BOOLEAN; {TRUE if the file has been modified, TRUE if input and output files flipped} Membuf: Membuffer; {Memory buffer} In_File, Out_File: BOOLEAN; {TRUE if a file has been opened} I_File, O_File: INTEGER; {Pointers to files} END; {Pointers into memory buffer} Char_Type=(Ch_Pad,Ch_G_Pad,Ch_Cont,Ch_G_Cont,Ch_Char,Ch_G_Char,Ch_Undef); {Input character types} Out_Body=ARRAY [1..Rec_Length] OF CHAR; Long_String=VARYING [256] OF CHAR; VAR { Screen Database: The screen database consists of two screen image arrays: My_Screen: Contains an image of what the program has written to the screen. His_Screen: Contains an image of what the optimizer knows is on the screen The position at which the program has places the cursor is in My_Line and My_Col The position at which the optimizer has placed the cursor is in His_Line and His_Col The range of line numbers on the screen that My_Line will be kept within is in Cursor_Top and Cursor_Bottom. The line number that the cursor will be positioned at on a fresh screen is in Cursor_Middle To keep track of what changes have been made there are a number of variables: Any_Changes TRUE if My_Screen is different from His_Sceen Changes Indexed by line number and contains the number of characters that are different between My_Screen and His_Screen for that line. Last_Col Indexed by line and contains the column number of the last (possibly) nonblank column in My_Screen. Many functions in the screen optimizer are terminal dependent. The current terminal type is contained in Term_Type File buffers File buffers are windows into indefinitely large data buckets. The datatype associated with such a buffer is in the PASCAL type buffer. The buffer has two windows associated with it. The files are taken from a general work file pool. There are two indices into that pool I_File Index into Main_In O_File Index into Main_Out Whether these file are curently open is indicated in two BOOLEAN variables In_File TRUE if I_File is open Out_File TRUE if O_File is open The main memory component is stored in a character array Membuf The accessible part of the buffer Data is read or written into Membuf from either I_File or O_File. Flip BOOLEAN variable. If Flip is FALSE data will be read from I_File and written to O_File. When it is false data will be read from O_File and written to I_File. Track is being kept of which reord number will be the next read and written Inno Contains the record number that will be read into buffer next Outno Contains the record number that will be written to next Topout Contains the highest record number that has been written As long as the buffer has not been modified after having been written out completely, random accesses may be performed. Modified TRUE if any modification has been made after the last complete write to a file. Within the window into the buffer a number of pointers identify the current byte. Pos Contains the absolute position of the byte within the buffer Bufsize Contains the amount of data within the window Memstart Contains the absolute byte number of the first byte in the window Memptr Contains the relative position within the window of the byte Edit Buffer database The edit buffer database consists of a file buffer and a number of pointers into it. There is always a current edit buffer and a number of saved buffers. The index into the saved buffers that the current buffer must be saved in is contained in Current_Buffer The initial file is loaded into edit buffer number 1. All other files must be loaded and saved manually. My_Pos Contains the position of the byte within the file that the cursor is currently placed at This_Pos Contains the position within the file that the current line starts at This_Line Contains the absolute line number within the file of the current line Before_Pos Is an array containing the starting positions within the file of lines before the current line. Before_Pos[1] contains the starting position of the line just before the current. Before_Got Contains the number of valid entried in Before_Pos. After_Pos Is an array containing the starting positions within the file of lines after the current line. Before_Pos[1] contains the stating position of the next line. After_Got Contains the number of valis entries in After_Pos. Sel_Pos Contains the position within the file marked with Select Marks Is an array of positions within the file marked with Mark Used An Indicator whether this particular buffer has been used before Saved File windows and screen databases are put into arrays named Save_ Other global variables: Scroll_Top, Scroll_Bottom Keep track of scroll regions on VT100 compatible terminals Error_Flag Signals that an error has ocured, and command processing should be terminated Ctrlc_Flag Signals that a contol C has been typed Got_Char Signals that there is type ahead Com Buffer used for command parsing Pad Utility buffer for keypad definitions, delete strings, etc. Move Negative of the last number of characters moved, or the size of the last insert. Out_Buffer Holding buffer for characters to be sent to the terminal. Out_Size The number of characters in Out_Buffer Char_Buffer Holding buffer for characters read from the terminal. In_Buffer Asyncronous terminal reads are made into In_Buffer. When Char_Buffer gets empty, the contents of In_Buffer get moved to Char_Buffer In_Size The number of characters in Char_Buffer In_Index The index in Char_Buffer of the last character passed to the parser. Dsk_Block Used when writing to file buffers. Input_Name The name of the current input file. Output_name The name of the current output file. Com_Name The name of the command file passed. Journal_Name The name of the current journal file. Left_Margin The current left margin position. Right_Margin The current right margin position Screen_Width The width of the screen Tab_Stops Table of user settable tab stops Tabs The number of tab stops set Echo Flag that indicated whether the next read can be with echo Rep_Count The count entered before a command Ent_Count The count entered before an entity Direction The direction of this command Def_Direction The default direction for commands Sign The Sign just read from the command buffer Ent_Begin The position within the buffer of the start of current entity Ent_End The position within the buffer of the end of the current entity Ent_Pos The position within the buffer of the current entity B_ The position within the pad buffer that contains the buffer for the entity L_ The number of characters in the buffer for that entity Char Character Word Word Line Line Paste Paste Delete General delete Search Search object Subs Substitute string Com_End TRUE if we have read a complete command from a keypad definition ( . at the end) Com_Begin TRUE if we are at the beginning of a command Gold TRUE if the last key pressed was Gold Do_Echo TRUE if the current read is with echo _Start The indices into the pad buffer of the definition strings for keys. _Length The lengths if key definition strings Pad Programmable keypad G_Pad Gold Programmable keypad Cont Control characters G_Cont Gold control characters G_Char Gold character V_Col The saved column number for vertical moves F_Col The current column number for vertical moves Journal_Body Array holding input characters to be written into the journal file Journal_Length The number of characters in Journal_Body Journal_Rec Output record for the journal file Journal_File File for journaling Journal_Flag TRUE if journaling is enabled Recover_Flag TRUE if we are in the process of recovering Mode Current editing mode 1: Program mode 2: Text mode } Term_Type:Term_Types; Scroll_Top, Scroll_Bottom, Cursor_Top, Cursor_Bottom, Cursor_Middle, Move: INTEGER; Out_Buffer, In_Buffer, Char_Buffer: Out_Body; Out_Size, In_Size, In_Index: INTEGER; My_Screen, His_Screen: Screen; Changes, Last_Col: Screen_Info; My_Line, My_Col, His_Line, His_Col: INTEGER; Dsk_Block: Buf_Block; Alpha, Alpha_L, Alpha_U, Plus_Minus, Digits, Printable, Non_Printable, Word_Delim: SET OF CHAR; Input_Name, Output_Name, Com_Name, Journal_Name: Long_String; Left_Margin, Right_Margin, Screen_Width: INTEGER; Any_Changes: BOOLEAN; Current_Buffer, Working: INTEGER; This_line, This_Pos, Before_Got, After_Got, My_Pos, Sel_Pos: INTEGER; Save_This_line, Save_This_Pos, Save_Before_Got, Save_After_Got, Save_My_Pos, Save_Sel_Pos, Save_My_Line, Save_My_Col: ARRAY [1..Maxbuffers] OF INTEGER; Save_Used: ARRAY [1..Maxbuffers] OF BOOLEAN; Used: BOOLEAN; Main_In, Main_Out: ARRAY [1..Maxbuffers+2] OF FILE OF Buf_Block; Main: Buffer; Save_Main: ARRAY [1..Maxbuffers] OF Buffer; Save_My_Screen: ARRAY [1..Maxbuffers] OF Screen; Before_Pos, After_Pos: ARRAY [1..Window] OF INTEGER; Save_Before_Pos, Save_After_Pos: ARRAY [1..Maxbuffers,1..Window] OF INTEGER; Marks: ARRAY [1..Maxmarks+2] OF INTEGER; Tab_Stops: ARRAY [1..Maxtabs] OF INTEGER; Tabs: INTEGER; Save_Marks: ARRAY [1..Maxbuffers,1..Maxmarks+2] OF INTEGER; Error_Flag, Ctrlc_Flag, Got_Char, Echo: [GLOBAL] BOOLEAN; Com, Pad: Buffer; Entity, L_Entity: (E_ILL,E_BL,E_BPAGE,E_BPAR,E_BR,E_BSEN,E_BW,E_C,E_EL,E_EPAGE, E_EPAR,E_ER,E_ESEN,E_EW,E_L,E_NL,E_PAGE,E_PAR,E_QUOTE,E_SEN,E_SR,E_V,E_W, E_NS,E_GOTO); Command, L_Command: (C_ILL,C_ADV,C_ASC,C_BACK,C_CB,C_CEN,C_CGC,C_CM,C_CT, C_CUT,C_DEFK,C_DEL,C_DI,C_EB,C_EX,C_FE,C_FI,C_FO,C_FW,C_GET,C_HELP,C_I, C_KS,C_MARK,C_ML,C_MODE,C_MR,C_PASTE,C_QUIT,C_REF,C_RES,C_SEL,C_SN, C_SUB,C_STA,C_TAB,C_TAK,C_TC,C_TD,C_TF,C_TI,C_TN,C_TS,C_TW,C_UNDC,C_UNDD, C_UNDL,C_UNDW,C_Z,C_NULL,C_CIRCUMFLEX); Rep_Count, Ent_Count: INTEGER; Direction, Def_Direction, Sign: D_Type; Ent_Begin, Ent_End, Ent_Pos: INTEGER; B_Char, L_Char, B_Word, L_Word, B_Line, L_Line, B_Paste, L_Paste, B_Delete, L_Delete, B_Search, L_Search, B_Subs, L_Subs: INTEGER; Com_End, Gold, Do_Echo, Com_Begin: BOOLEAN; Pad_Start, Pad_Length, G_Pad_Start, G_Pad_Length: ARRAY [0..45] OF INTEGER; Cont_Start, Cont_Length, G_Cont_Start, G_Cont_Length: ARRAY [0..159] OF INTEGER; G_Char_Start, G_Char_Length: ARRAY [33..255] OF INTEGER; V_Col, F_Col: INTEGER; Journal_Body: Character_Array; Journal_Rec: Long_String; Journal_Length: INTEGER; Journal_File: FILE OF Long_String; Recover_Flag, Journal_Flag: BOOLEAN; Mode: INTEGER; Version: String; PROCEDURE T$Init; EXTERNAL; {Initializes the terminal} FUNCTION T$Get:INTEGER; EXTERNAL; {Gets input, returns number of chars} PROCEDURE T$Start(VAR S:Out_Body;L:INTEGER);EXTERNAL; {Initializes an async input request and sets terminal modes} PROCEDURE T$Startone(VAR S:Out_Body;L:INTEGER);EXTERNAL; {Starts an async single character input} PROCEDURE T$Startmany(VAR S:Out_Body;L:INTEGER);EXTERNAL; {Starts a multi-character input with echo} PROCEDURE T$Cancel;EXTERNAL; {Cancels a pending I/O request} PROCEDURE T$Put(VAR S:Out_Body;L:INTEGER);EXTERNAL; {Outputs a string} PROCEDURE C$Move(VAR Src, Dst:CHAR;L:INTEGER);EXTERNAL; {Moves L characters from SRC to DST} PROCEDURE L$Move(VAR Src:Edit_Body;VAR Dst:CHAR;L:INTEGER);EXTERNAL; {Moves L characters from SRC to DST} PROCEDURE S$Move(VAR Src:CHAR;VAR Dst:Edit_Body;L:INTEGER);EXTERNAL; {Moves L characters from SRC to DST} PROCEDURE X$Move(VAR Src: S_Body;VAR Dst:CHAR;L:INTEGER);EXTERNAL; {Moves L characters from SRC to DST} PROCEDURE I$Move(VAR Src, Dst:INTEGER;L:INTEGER);EXTERNAL; {Moves L words from SRC to DST} PROCEDURE C$Fill(VAR Dst:CHAR;L:INTEGER;C:CHAR);EXTERNAL; {Inserts L character C's at Dst} PROCEDURE I$Fill(VAR Dst:INTEGER;L,V:INTEGER);EXTERNAL; {Fills an integer array with V} PROCEDURE I$Add(VAR Src:INTEGER;N, V:INTEGER);EXTERNAL; {Adds the value V to N words starting at Src} FUNCTION C$Scan(VAR Src:CHAR;L:INTEGER;C:CHAR):INTEGER;EXTERNAL; {Scans for character C for L characters from location Src} FUNCTION C$Bscan(VAR Src:CHAR;L:INTEGER;C:CHAR):INTEGER;EXTERNAL; {Scans for character C for -L characters from location Src} FUNCTION C$Comp(VAR Src, Dst:CHAR;L:INTEGER):INTEGER;EXTERNAL; {Compares Src and Dst and returns the number of the first different byte} [GLOBAL] PROCEDURE Change_Comp(First_Line, Last_Line: INTEGER); {Recalculates the values of Changes and Last_Col} VAR This_Line, This_Col: INTEGER; This_Char, That_Char: CHAR; BEGIN FOR This_Line:=First_Line TO Last_Line DO BEGIN Last_Col[This_Line]:=0; Changes[This_Line]:=0; FOR This_Col:=1 TO Maxcol DO BEGIN This_Char:=My_Screen[This_Line,This_Col]; That_Char:=His_Screen[This_Line,This_Col]; IF This_Char<>That_Char THEN BEGIN Any_Changes:=TRUE; Changes[This_Line]:=Changes[This_Line]+1; END; IF (This_Char<>' ') OR (That_Char<>' ') THEN Last_Col[This_Line]:=This_Col; END; END; END; [GLOBAL] PROCEDURE Out_Zap; {Outputs all characters in Out_Buffer to the terminal} BEGIN IF Out_Size<>0 THEN BEGIN T$PUT(Out_Buffer,Out_Size); Out_Size:=0; END; END; [GLOBAL] PROCEDURE Put_Char(C: CHAR); {Inserts C in Out_Buffer. If Out_Buffer runs full it does an Out_Zap} BEGIN Out_Size:=Out_Size+1; Out_Buffer[Out_Size]:=C; IF Out_Size=Rec_Length THEN Out_Zap; END; [GLOBAL] PROCEDURE Escape(S: String); {Puts the string S preceeded by an escape character into Out_Buffer} VAR I: INTEGER; BEGIN Put_Char(''(27)''); FOR I:=1 TO LENGTH(S) DO Put_Char(S[I]); END; [GLOBAL] PROCEDURE Put_String(S: String); {Put the string S into Out_Buffer} VAR I: INTEGER; BEGIN FOR I:=1 TO LENGTH(S) DO Put_Char(S[I]); END; [GLOBAL] PROCEDURE Clear_Screen; {Outputs the appropriate escape sequence to clear the screen} BEGIN CASE Term_Type OF VT200: Put_String(''(155)'2J'); VT100,VT102,VK100: Escape('[2J'); VT52: BEGIN Escape('H'); Escape('J'); END; END; END; [GLOBAL] PROCEDURE Erase_Line; {Outputs the appropriate escape sequence to erase to the end of the line} BEGIN CASE Term_Type OF VT200: Put_String(''(155)'K'); VT100,VT102,VK100: Escape('[K'); VT52: Escape('K'); END; END; [GLOBAL] PROCEDURE Set_Cursor(Line, Col: INTEGER); {Outputs the appropriate escape sequence to place the cursor} VAR S: String; BEGIN CASE Term_Type OF VT200: BEGIN Put_Char(''(155)''); WRITEV(S,Line:1); Put_String(S); Put_Char(';'); WRITEV(S,Col:1); Put_String(S); Put_Char('H'); END; VT100,VT102,VK100: BEGIN Escape('['); WRITEV(S,Line:1); Put_String(S); Put_Char(';'); WRITEV(S,Col:1); Put_String(S); Put_Char('H'); END; VT52: BEGIN Escape('Y'); Put_Char(CHR(31+Line)); Put_Char(CHR(31+Col)); END; END; His_Line:=Line; His_Col:=Col; END; [GLOBAL] PROCEDURE Set_Scroll(First, Last:INTEGER); {Outputs the appropriate escape sequence to set a scroll region} VAR S: String; BEGIN IF (Scroll_Top<>First) OR (Scroll_Bottom<>Last) THEN BEGIN CASE Term_Type OF VT200: Put_Char(''(155)''); VT100,VT102: Escape('['); END; WRITEV(S,First:1); Put_String(S); Put_Char(';'); WRITEV(S,Last:1); Put_String(S); Put_Char('r'); Scroll_Top:=First; Scroll_Bottom:=Last; END; END; [GLOBAL] PROCEDURE OPT_Init; {Initializes the screen optimization routine} BEGIN Any_Changes:=FALSE; I$Fill(Changes[1],Maxlines,0); I$Fill(Last_Col[1],Maxlines,0); C$FILL(My_Screen[1,1],Maxlines*Maxcol,' '); C$FILL(His_Screen[1,1],Maxlines*Maxcol,' '); My_Line:=1; My_Col:=1; His_Line:=1; His_Col:=1; Clear_Screen; Set_Cursor(My_Line,My_Col); Out_Zap; END; [GLOBAL] PROCEDURE Opt_Move_Cursor(Temp_Line,Temp_Col:INTEGER); {Does an optimal cursor positioning} VAR S: String; BEGIN IF Temp_Line=His_Line THEN BEGIN {We don't have to move vertically} IF Temp_Col>His_Col THEN BEGIN {This is a move to the right} IF Temp_Col-His_Col<4 THEN BEGIN {Just write the characters on the screen} WHILE Temp_Col<>His_Col DO BEGIN Put_Char(His_Screen[His_Line,His_Col]); His_Col:=His_Col+1; END; END ELSE IF Term_Type IN [VT100,VK100,VT102] THEN BEGIN {Single escape sequence will do the job} Escape('['); WRITEV(S,Temp_Col-His_Col:1); Put_String(S); Put_Char('C'); His_Col:=Temp_Col; END ELSE IF Term_Type=VT200 THEN BEGIN {Use extended ASCII sequence} Put_Char(''(155)''); WRITEV(S,Temp_Col-His_Col:1); Put_String(S); Put_Char('C'); His_Col:=Temp_Col; END ELSE Set_Cursor(Temp_Line,Temp_Col); END ELSE IF Temp_ColScreen_Width THEN Set_Cursor(Temp_Line,Temp_Col) ELSE IF (His_Col-Temp_Col<4) AND (His_Col-Temp_ColTemp_Col DO BEGIN Put_Char(His_Screen[His_Line,His_Col]); His_Col:=His_Col+1; END; END ELSE Set_Cursor(Temp_Line,Temp_Col); END ELSE Set_Cursor(Temp_Line,Temp_Col); END; END; [GLOBAL] PROCEDURE OPT_Put_Char(C: CHAR); {Inserts a character into the screen database} VAR My_Char, His_Char: CHAR; BEGIN IF My_Col<=Maxcol THEN BEGIN {It's in our image} IF My_Col>Last_Col[My_Line] THEN BEGIN {We are in virgin territory, we know it's blank} IF ' '<>C THEN BEGIN {This is a non-blank character} His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN {We do an immediate insertion} IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN {We put it in our database and let an update output it later} IF His_Char=' ' THEN BEGIN {We are overwriting a blank character} Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; Last_Col[My_Line]:=My_Col; END; END ELSE BEGIN {Somebody has been here before} My_Char:=My_Screen[My_Line,My_Col]; IF My_Char<>C THEN BEGIN {We are overwriting a different character} His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN {Do an immediate insertion} IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN {Insert with deferred update} IF His_Char=My_Char THEN BEGIN {This position was updated} Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; IF My_Col>Last_Col[My_Line] THEN Last_Col[My_Line]:=My_Col; END; END; END; My_Col:=My_Col+1; END; [GLOBAL] PROCEDURE OPT_Put_String(S: String); {Inserts a character into the screen database} VAR My_Char, His_Char, C: CHAR; I: INTEGER; BEGIN FOR I:=1 TO LENGTH(S) DO BEGIN C:=S[I]; {This is a copy of the OPT_Put_Char code} IF My_Col<=Maxcol THEN BEGIN IF My_Col>Last_Col[My_Line] THEN BEGIN IF ' '<>C THEN BEGIN His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN IF His_Char=' ' THEN BEGIN Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; Last_Col[My_Line]:=My_Col; END; END ELSE BEGIN My_Char:=My_Screen[My_Line,My_Col]; IF My_Char<>C THEN BEGIN His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN IF His_Char=My_Char THEN BEGIN Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; IF My_Col>Last_Col[My_Line] THEN Last_Col[My_Line]:=My_Col; END; END; END; My_Col:=My_Col+1; END; END; [GLOBAL] PROCEDURE OPT_Update(First_Line, Last_Line:INTEGER); {Puts all changes in the screen database out on the terminal} VAR Temp_Change, Temp_Line, Temp_Col: INTEGER; My_Char: CHAR; Erased: BOOLEAN; LABEL 1; BEGIN IF Any_Changes THEN FOR Temp_Line:=First_Line TO Last_Line DO BEGIN {Update on a line by line basis} Erased:=FALSE; Temp_Change:=Changes[Temp_Line]; IF Temp_Change<>0 THEN BEGIN {There is something to do on this line} IF Got_Char THEN GOTO 1; Temp_Col:=1; WHILE Temp_Change<>0 DO BEGIN {Repeat until we have found them all} Temp_Col:=Temp_Col+C$Comp(My_Screen[Temp_Line,Temp_Col], His_Screen[Temp_Line,Temp_Col],Maxcol-Temp_Col+1); My_Char:=My_Screen[Temp_Line,Temp_Col]; His_Screen[Temp_Line,Temp_Col]:=My_Char; Temp_Change:=Temp_Change-1; IF NOT Erased THEN IF (His_Line<>Temp_Line) OR (His_Col<>Temp_Col) THEN Opt_Move_Cursor(Temp_Line,Temp_Col); IF Temp_Col>Last_Col[Temp_Line] THEN BEGIN {we are in blank territory} IF NOT Erased THEN BEGIN Erase_Line; Erased:=TRUE; END; END ELSE BEGIN Put_Char(My_Char); His_Col:=His_Col+1; END; Temp_Col:=Temp_Col+1; END; Changes[Temp_Line]:=0; END; END; IF (First_Line=1) AND (Last_Line=Maxlines) THEN Any_Changes:=FALSE; IF (His_Line<>My_Line) OR (His_Col<>My_Col) THEN Opt_Move_Cursor(My_Line,My_Col); 1: END; [GLOBAL] PROCEDURE OPT_L_Erase; {Erases to the end of the current line in the screen database} VAR Save_Col, Last: INTEGER; My_Char: CHAR; BEGIN IF My_Col<=Last_Col[My_Line] THEN BEGIN Save_Col:=My_Col; Last:=Last_Col[My_Line]; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN {We do an immediate screen update} IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); Erase_Line; C$Fill(My_Screen[My_Line,Save_Col],Last-Save_Col+1,' '); C$Fill(His_Screen[My_Line,Save_Col],Last-Save_Col+1,' '); END ELSE BEGIN REPEAT IF My_Screen[My_Line,My_Col]=' ' THEN My_Col:=My_Col+1 ELSE OPT_Put_Char(' '); UNTIL My_Col>Last; END; My_Col:=Save_Col; Last_Col[My_Line]:=My_Col-1; END; END; [GLOBAL] PROCEDURE OPT_Clr_Screen; {Clears the screen database} VAR Save_Line, Save_Col: INTEGER; BEGIN Save_Line:=My_Line; Save_Col:=My_Col; FOR My_Line:=1 TO Maxlines DO BEGIN My_Col:=1; OPT_L_Erase; END; My_Line:=Save_Line; My_Col:=Save_Col; END; [GLOBAL] Procedure Remove_Lines(Lines, Start: INTEGER); {Removes Lines lines on a VT102/VT200 type terminal} VAR S: String; BEGIN Set_Cursor(Start,1); IF Term_Type=VT102 THEN Escape('[') ELSE Put_Char(''(155)''); WRITEV(S,Lines:1); Put_String(S); Put_Char('M'); END; [GLOBAL] PROCEDURE Fill_Screen(First_Line,First_Col,Bott_Line,Bott_Col,First_Pos: INTEGER);FORWARD; [GLOBAL] PROCEDURE OPT_Close_Lines(Lines:INTEGER); {Removes lines from screen database} VAR I: INTEGER; BEGIN IF My_Line+Lines>=Maxlines THEN Lines:=Maxlines-My_Line+1; CASE Term_Type OF VT52,VK100: BEGIN IF My_Col=1 THEN BEGIN IF My_Line+Lines<=Maxlines THEN C$Move(My_Screen[My_Line+Lines,1],My_Screen[My_Line,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); C$Fill(My_Screen[Maxlines-Lines+1,1],Lines*Maxcol,' '); Change_Comp(My_Line,Maxlines); END ELSE BEGIN Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); IF My_Line+Lines+1<=Maxlines THEN C$Move(My_Screen[My_Line+1+Lines,1],My_Screen[My_Line+1,1], (Maxlines-(My_Line+1+Lines)+1)*Maxcol); IF My_Line+Lines=Maxlines+1 THEN C$Fill(My_Screen[Maxlines-Lines+2,1],(Lines-1)*Maxcol,' ') ELSE C$Fill(My_Screen[Maxlines-Lines+1,1],Lines*Maxcol,' '); Change_Comp(My_Line+1,Maxlines); END; END; VT100,VT102,VT200: BEGIN IF My_Line+Lines<=Maxlines THEN BEGIN IF My_Col=1 THEN BEGIN Set_Scroll(My_Line,Maxlines); IF Term_Type IN [VT102,VT200] THEN Remove_Lines(Lines,My_Line) ELSE BEGIN Set_Cursor(Maxlines,1); FOR I:=1 TO Lines DO Put_Char(''(10)''); END; C$Move(My_Screen[My_Line+Lines,1],My_Screen[My_Line,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); C$Move(His_Screen[My_Line+Lines,1],His_Screen[My_Line,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); I$Move(Changes[My_Line+Lines],Changes[My_Line], Maxlines-(My_Line+Lines)+1); I$Move(Last_Col[My_Line+Lines],Last_Col[My_Line], Maxlines-(My_Line+Lines)+1); C$Fill(My_Screen[Maxlines-Lines+1,1],Lines*Maxcol,' '); C$Fill(His_Screen[Maxlines-Lines+1,1],Lines*Maxcol,' '); I$Fill(Changes[Maxlines-Lines+1],Lines,0); I$Fill(Last_Col[Maxlines-Lines+1],Lines,0); END ELSE IF My_Line+Lines1 THEN C$FILL(My_Screen[My_Line+1,1],(Lines-1)*Maxcol,' '); Change_Comp(My_Line,Maxlines); END; VK100: BEGIN IF My_Line+Lines<=Maxlines THEN BEGIN IF My_Col=1 THEN BEGIN C$Move(My_Screen[My_Line,1],My_Screen[My_Line+Lines,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); END ELSE BEGIN IF My_Line+Lines1 THEN C$Fill(My_Screen[My_Line+1,1],(Lines-1)*Maxcol,' '); Change_Comp(My_Line,Maxlines); END; VT100,VT102,VT200: BEGIN IF My_Line+Lines<=Maxlines THEN BEGIN IF My_Col=1 THEN BEGIN Set_Scroll(My_Line,Maxlines); Set_Cursor(My_Line,1); IF Term_Type=VT100 THEN BEGIN FOR I:=1 TO Lines DO Escape('M'); END ELSE Insert_Lines(Lines); C$Move(My_Screen[My_Line,1],My_Screen[My_Line+Lines,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); C$Move(His_Screen[My_Line,1],His_Screen[My_Line+Lines,1], (Maxlines-(My_Line+Lines)+1)*Maxcol); I$Move(Changes[My_Line],Changes[My_Line+Lines], Maxlines-(My_Line+Lines)+1); I$Move(Last_Col[My_Line],Last_Col[My_Line+Lines], Maxlines-(My_Line+Lines)+1); I$Fill(Changes[My_Line],Lines,0); I$Fill(Last_Col[My_Line],Lines,0); C$Fill(His_Screen[My_Line,1],Lines*Maxcol,' '); C$Fill(My_Screen[My_Line,1],Lines*Maxcol,' '); END ELSE IF My_Line+Lines1 THEN C$Fill(My_Screen[My_Line+1,1],(Lines-1)*Maxcol,' '); Change_Comp(My_Line,Maxlines); END; END ELSE BEGIN Lines:=Maxlines-My_Line; C$Fill(My_Screen[My_Line,My_Col],Maxcol-My_Col+1,' '); IF Lines>1 THEN C$Fill(My_Screen[My_Line+1,1],(Lines-1)*Maxcol,' '); Change_Comp(My_Line,Maxlines); END; END; END; END; [GLOBAL] PROCEDURE OPT_Scroll(Lines: INTEGER); {Scrolls the screen database Lines} VAR I: INTEGER; BEGIN IF Lines<0 THEN BEGIN Lines:=-Lines; CASE Term_Type OF VT52: BEGIN Set_Cursor(1,1); FOR I:=1 TO Lines DO Escape('I'); C$Move(My_Screen[1,1],My_Screen[Lines+1,1],(Maxlines-Lines)*Maxcol); C$Move(His_Screen[1,1],His_Screen[Lines+1,1],(Maxlines-Lines)*Maxcol); C$Fill(My_Screen[1,1],Lines*Maxcol,' '); C$Fill(His_Screen[1,1],Lines*Maxcol,' '); I$Move(Changes[1],Changes[Lines+1],Maxlines-Lines); I$Move(Last_Col[1],Last_Col[Lines+1],Maxlines-Lines); I$Fill(Changes[1],Lines,0); I$Fill(Last_Col[1],Lines,0); His_Line:=1; His_Col:=1; END; VT100,VT102,VK100,VT200: BEGIN IF Term_Type IN [VT100,VT102,VT200] THEN Set_Scroll(1,Maxlines); Set_Cursor(1,1); IF Term_Type=VT200 THEN BEGIN FOR I:=1 TO Lines DO Put_Char(''(141)''); END ELSE BEGIN FOR I:=1 TO Lines DO Escape('M'); END; C$Move(My_Screen[1,1],My_Screen[Lines+1,1],(Maxlines-Lines)*Maxcol); C$Move(His_Screen[1,1],His_Screen[Lines+1,1],(Maxlines-Lines)*Maxcol); C$Fill(My_Screen[1,1],Lines*Maxcol,' '); C$Fill(His_Screen[1,1],Lines*Maxcol,' '); I$Move(Changes[1],Changes[Lines+1],Maxlines-Lines); I$Move(Last_Col[1],Last_Col[Lines+1],Maxlines-Lines); I$Fill(Changes[1],Lines,0); I$Fill(Last_Col[1],Lines,0); His_Line:=1; His_Col:=1; END; END; END ELSE IF Lines>0 THEN BEGIN CASE Term_Type OF VT52,VT100,VT102,VK100,VT200: BEGIN IF Term_Type IN [VT100,VT102,VT200] THEN Set_Scroll(1,Maxlines); Set_Cursor(Maxlines,1); FOR I:=1 TO Lines DO Put_Char(''(10)''); C$Move(My_Screen[Lines+1,1],My_Screen[1,1],(Maxlines-Lines)*Maxcol); C$Move(His_Screen[Lines+1,1],His_Screen[1,1],(Maxlines-Lines)*Maxcol); C$Fill(My_Screen[Maxlines+1-Lines,1],Lines*Maxcol,' '); C$Fill(His_Screen[Maxlines+1-Lines,1],Lines*Maxcol,' '); I$Move(Changes[Lines+1],Changes[1],Maxlines-Lines); I$Move(Last_Col[Lines+1],Last_Col[1],Maxlines-Lines); I$Fill(Changes[Maxlines+1-Lines],Lines,0); I$Fill(Last_Col[Maxlines+1-Lines],Lines,0); His_Line:=Maxlines; His_Col:=1; END; END; END; END; {Buffer subroutines} [GLOBAL] PROCEDURE Blockread(VAR F: Tempfile; VAR B: Buf_Block; P: INTEGER); {Reads record number P from file F} BEGIN FIND(F,P+1); READ(F,B); END; [GLOBAL] PROCEDURE Blockwrite(VAR F: Tempfile; VAR B: Buf_Block; P: INTEGER); {Writes record number P into F} BEGIN LOCATE(F,P+1); WRITE(F,B); END; [GLOBAL] PROCEDURE Out_Buf(VAR B_Buffer: Buffer); {Outputs a record from the buffer} BEGIN WITH B_Buffer DO BEGIN IF NOT Out_File THEN BEGIN Out_File:=TRUE; IF Flip THEN OPEN(Main_In[I_File],HISTORY:=NEW,RECORD_LENGTH:=Blocksize, ACCESS_METHOD:=DIRECT,DISPOSITION:=DELETE,SHARING:=READWRITE) ELSE OPEN(Main_Out[O_File],HISTORY:=NEW,RECORD_LENGTH:=Blocksize, ACCESS_METHOD:=DIRECT,DISPOSITION:=DELETE,SHARING:=READWRITE); IF Flip THEN REWRITE(Main_In[I_File]) ELSE REWRITE(Main_Out[O_File]); END; IF Modified OR (Outno>=Topout) THEN BEGIN C$Move(Membuf[1],Dsk_Block[1],Blocksize); IF Flip THEN BLOCKWRITE(Main_In[I_File],Dsk_Block,Outno) ELSE BLOCKWRITE(Main_Out[O_File],Dsk_Block,Outno); Topout:=Outno+1; END; Outno:=Outno+1; C$Move(Membuf[Blocksize+1],Membuf[1],Memmax-Blocksize); Memsize:=Memsize-Blocksize; Memptr:=Memptr-Blocksize; Memstart:=Memstart+Blocksize; END; END; [GLOBAL] PROCEDURE In_Buf(VAR B_Buffer: Buffer); {Reads a record into the buffer} VAR Save_Line, Save_Col: INTEGER; BEGIN Working:=Working+1; IF Working=Working_Toggle THEN BEGIN Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; OPT_Put_String('Working...'); My_Line:=Save_Line; My_Col:=Save_Col; OPT_Update(Maxlines,Maxlines); Set_Cursor(Maxlines,1); Out_Zap; Set_Cursor(His_Line,His_Col); My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; My_Line:=Save_Line; My_Col:=Save_Col; END; WITH B_Buffer DO BEGIN IF Flip THEN BLOCKREAD(Main_Out[O_File],Dsk_Block,Inno) ELSE BLOCKREAD(Main_In[I_File],Dsk_Block,Inno); C$Move(Dsk_Block[1],Membuf[Memsize+1],Blocksize); Inno:=Inno+1; Memsize:=Memsize+Blocksize; END; END; [GLOBAL] PROCEDURE Buf_Flush(VAR B_Buffer: Buffer); {Flushes the entire buffer to the output file} BEGIN WITH B_Buffer DO BEGIN WHILE Memstart+Memsize<=Bufsize DO BEGIN IF Memsize0 DO Out_Buf(B_Buffer); END; END; [GLOBAL] PROCEDURE Buf_Rewind(VAR B_Buffer: Buffer); {Flushes the buffer and sets it to the beginning} BEGIN WITH B_Buffer DO BEGIN Buf_Flush(B_Buffer); IF In_File THEN IF Flip THEN CLOSE(Main_Out[O_File],DELETE) ELSE CLOSE(Main_In[I_File],DELETE); Flip:=NOT Flip; In_File:=Out_File; Out_File:=FALSE; Inno:=0; Outno:=0; Topout:=0; Memstart:=1; Memsize:=0; Memptr:=1; Pos:=1; Modified:=FALSE; END; END; [GLOBAL] PROCEDURE Buf_Goto(VAR B_Buffer: Buffer; Point: INTEGER); {Sets the buffer pointers to character number Point} BEGIN WITH B_Buffer DO BEGIN IF PointTopout THEN WHILE Memsize>0 DO Out_Buf(B_Buffer); Inno:=(Point-1) DIV Blocksize; Outno:=Inno; Memsize:=0; Memstart:=Inno*Blocksize+1; IF Inno<>0 THEN BEGIN Memstart:=Memstart-Blocksize; Inno:=Inno-1; Outno:=Outno-1; In_Buf(B_Buffer); END; In_Buf(B_Buffer); END; END; IF Point>=Memstart+Memsize THEN BEGIN IF Point>Bufsize THEN BEGIN IF Memstart+Memsize=Memstart+Memmax) THEN BEGIN IF Inno<>(Point-1) DIV Blocksize THEN BEGIN Inno:=(Point-1) DIV Blocksize; Outno:=Inno; Memsize:=0; Memstart:=Inno*Blocksize+1; IF Inno<>0 THEN BEGIN Memstart:=Memstart-Blocksize; Inno:=Inno-1; Outno:=Outno-1; In_Buf(B_Buffer); END; END ELSE IF Memmax-Memsize=Memstart+Memsize DO BEGIN IF Memmax-Memsize=Memptr THEN C$Move(Membuf[Memptr],Membuf[Memptr+1],Memsize-Memptr+1); Memsize:=Memsize+1; Membuf[Memptr]:=C; Memptr:=Memptr+1; Pos:=Pos+1; Bufsize:=Bufsize+1; Modified:=TRUE; END; END; [GLOBAL] PROCEDURE Buf_Put_S(VAR B_Buffer: Buffer; S: String); {Inserts the string S into the buffer} VAR L, O: INTEGER; BEGIN WITH B_Buffer DO BEGIN O:=LENGTH(S); WHILE O>0 DO BEGIN IF Memsize=Memmax THEN Out_Buf(B_Buffer); IF O>Memmax-Memsize THEN L:=Memmax-Memsize ELSE L:=O; IF Memsize>=Memptr THEN C$Move(Membuf[Memptr],Membuf[Memptr+L],Memsize-Memptr+1); X$Move(S.BODY,Membuf[Memptr],L); Bufsize:=Bufsize+L; Memsize:=Memsize+L; Memptr:=Memptr+L; Pos:=Pos+L; Modified:=TRUE; O:=O-L; IF O<>0 THEN S:=SUBSTR(S,L,LENGTH(S)-L); END; END; END; [GLOBAL] FUNCTION Buf_Del(VAR B_Buffer: Buffer): CHAR; {Removes a character from the buffer} BEGIN WITH B_Buffer Do BEGIN IF Memptr>Memsize THEN Buf_Goto(B_Buffer,Pos); Buf_Del:=Membuf[Memptr]; C$Move(Membuf[Memptr+1],Membuf[Memptr],Memsize-Memptr); Memsize:=Memsize-1; Bufsize:=Bufsize-1; Modified:=TRUE; END; END; [GLOBAL] PROCEDURE Buf_Remove(VAR B_Buffer: Buffer; Chars:INTEGER); {Removes a character from the buffer} VAR I: INTEGER; BEGIN WITH B_Buffer Do BEGIN WHILE Chars<>0 DO BEGIN IF Memptr>Memsize THEN Buf_Goto(B_Buffer,Pos); I:=Memsize-Memptr+1; IF I>Chars THEN I:=Chars; IF Memsize-Memptr-I+1<>0 THEN C$Move(Membuf[Memptr+I],Membuf[Memptr],Memsize-Memptr+1-I); Memsize:=Memsize-I; Bufsize:=Bufsize-I; Chars:=Chars-I; Modified:=TRUE; END; END; END; [GLOBAL] PROCEDURE Buf_Copy(VAR F_Buffer: Buffer; VAR T_Buffer: Buffer;Chars: INTEGER); {Copies Chars characters from F_Buffer into T_Buffer} VAR I, Saveptr: INTEGER; BEGIN WHILE Chars<>0 DO BEGIN I:=Chars; WITH F_Buffer DO BEGIN IF Memptr>Memsize THEN Buf_Goto(F_Buffer,F_Buffer.Pos); IF I>Memsize-Memptr+1 THEN I:=Memsize-Memptr+1; END; WITH T_Buffer DO BEGIN IF Memsize=Memmax THEN BEGIN IF Memptr<=Blocksize THEN BEGIN Saveptr:=Pos; Buf_Rewind(T_Buffer); Buf_Goto(T_Buffer,Saveptr); IF Memsize=Memmax THEN OUT_Buf(T_Buffer); END ELSE Out_Buf(T_Buffer); END; IF I>Memmax-Memsize THEN I:=Memmax-Memsize; IF Memsize>=Memptr THEN C$Move(Membuf[Memptr],Membuf[Memptr+I],Memsize-Memptr+1); Memsize:=Memsize+I; C$Move(F_Buffer.Membuf[F_Buffer.Memptr],Membuf[Memptr],I); Memptr:=Memptr+I; Pos:=Pos+I; Bufsize:=Bufsize+I; Modified:=TRUE; END; WITH F_Buffer DO BEGIN Memptr:=Memptr+I; Pos:=Pos+I; END; Chars:=Chars-I; END; END; [GLOBAL] FUNCTION Buf_Get(VAR B_Buffer: Buffer): CHAR; {Gets a character from the buffer} BEGIN WITH B_Buffer DO BEGIN IF Memptr>Memsize THEN BEGIN IF Memmax-Memsize1 THEN BEGIN Buf_Goto(B_Buffer,Pos-1); END; END; Memptr:=Memptr-1; Pos:=Pos-1; Buf_B_Get:=Membuf[Memptr]; END; END; [GLOBAL] PROCEDURE Buf_Purge(VAR B_Buffer: Buffer); {Purges a buffer and removes all files} BEGIN WITH B_Buffer DO BEGIN IF In_File THEN IF Flip THEN CLOSE(Main_Out[O_File],DELETE) ELSE CLOSE(Main_In[I_File],DELETE); IF Out_File THEN IF Flip THEN CLOSE(Main_In[I_File],DELETE) ELSE CLOSE(Main_Out[O_File],DELETE); END; END; [GLOBAL] FUNCTION Scan(Count: INTEGER; C: CHAR;VAR B: Membuffer; Start: INTEGER): INTEGER; {Scans the memorybuffer for the character C} BEGIN IF Count<0 THEN Scan:=C$Bscan(B[Start],Count,C) ELSE Scan:=C$Scan(B[Start],Count,C); END; [GLOBAL] FUNCTION Buf_Find(VAR B_Buffer: Buffer;F_Char: CHAR): INTEGER; {Looks for the character C in the buffer} LABEL 1; VAR S_Pos, S_O_Pos: INTEGER; BEGIN Buf_Find:=0; WITH B_Buffer DO BEGIN IF Pos>Bufsize THEN GOTO 1; WHILE Pos<=Bufsize DO BEGIN IF Memptr=Memsize+1 THEN Buf_Goto(B_Buffer,Memstart+Memsize) ELSE BEGIN S_Pos:=SCAN(Memsize-Memptr+1,F_Char,Membuf,Memptr); IF S_Pos<>Memsize-Memptr+1 THEN BEGIN IF F_Char IN Alpha_L THEN BEGIN S_O_Pos:=SCAN(Memsize-Memptr+1,CHR(ORD(F_Char)-32),Membuf,Memptr); IF S_O_PosMemsize-Memptr+1 THEN BEGIN Buf_Goto(B_Buffer,Pos+S_Pos+1); Buf_Find:=Pos; GOTO 1; END; END ELSE IF F_Char IN Alpha_U THEN BEGIN S_Pos:=SCAN(Memsize-Memptr+1,CHR(ORD(F_Char)+32),Membuf,Memptr); IF S_Pos<>Memsize-Memptr+1 THEN BEGIN Buf_Goto(B_Buffer,Pos+S_Pos+1); Buf_Find:=Pos; GOTO 1; END; END ELSE IF F_Char=''(13)'' THEN BEGIN S_Pos:=SCAN(Memsize-Memptr+1,''(128)'',Membuf,Memptr); IF S_Pos<>Memsize-Memptr+1 THEN BEGIN Buf_Goto(B_Buffer,Pos+S_Pos+1); Buf_Find:=Pos; GOTO 1; END; END; Pos:=Pos+S_Pos; Memptr:=Memptr+S_Pos; END; END; END; 1: END; [GLOBAL] FUNCTION Buf_B_Find(VAR B_Buffer: Buffer;F_Char: CHAR): INTEGER; {Looks backward in the buffer for the character c} LABEL 1; VAR S_Pos, S_O_Pos: INTEGER; BEGIN Buf_B_Find:=0; WITH B_Buffer DO BEGIN IF Pos=1 THEN GOTO 1; Buf_Goto(B_Buffer,Pos-1); REPEAT S_Pos:=SCAN(-Memptr,F_Char,Membuf,Memptr); IF S_Pos<>-Memptr THEN BEGIN IF F_Char IN Alpha_L THEN BEGIN S_O_Pos:=SCAN(-Memptr,CHR(ORD(F_Char)-32),Membuf,Memptr); IF S_O_Pos>S_Pos THEN S_Pos:=S_O_Pos; END ELSE IF F_Char IN Alpha_U THEN BEGIN S_O_Pos:=SCAN(-Memptr,CHR(ORD(F_Char)+32),Membuf,Memptr); IF S_O_Pos>S_Pos THEN S_Pos:=S_O_Pos; END ELSE IF F_Char=''(13)'' THEN BEGIN S_O_Pos:=SCAN(-Memptr,''(128)'',Membuf,Memptr); IF S_O_Pos>S_Pos THEN S_Pos:=S_O_Pos; END; Pos:=Pos+S_Pos; Memptr:=Memptr+S_Pos; Buf_B_Find:=Pos; GOTO 1; END; IF F_Char IN Alpha_L THEN BEGIN S_Pos:=SCAN(-Memptr,CHR(ORD(F_Char)-32),Membuf,Memptr); IF S_Pos<>-Memptr THEN BEGIN Pos:=Pos+S_Pos; Memptr:=Memptr+S_Pos; Buf_B_Find:=Pos; GOTO 1; END; END ELSE IF F_Char IN Alpha_U THEN BEGIN S_Pos:=SCAN(-Memptr,CHR(ORD(F_Char)+32),Membuf,Memptr); IF S_Pos<>-Memptr THEN BEGIN Pos:=Pos+S_Pos; Memptr:=Memptr+S_Pos; Buf_B_Find:=Pos; GOTO 1; END; END ELSE IF F_Char=''(13)'' THEN BEGIN S_Pos:=SCAN(-Memptr,''(128)'',Membuf,Memptr); IF S_Pos<>-Memptr THEN BEGIN Pos:=Pos+S_Pos; Memptr:=Memptr+S_Pos; Buf_B_Find:=Pos; GOTO 1; END; END; IF Memstart=1 THEN GOTO 1; Buf_Goto(B_Buffer,Memstart-1); UNTIL FALSE; END; 1: END; [GLOBAL] PROCEDURE Char_Rep(O: INTEGER;VAR S: String;D: D_Type); {Returns the representation of the character with value O in the string S. Tabs use D and My_Col to figure out what it may be} VAR I: INTEGER; BEGIN IF CHR(O) IN Printable THEN BEGIN S:=' '; S[1]:=CHR(O); END ELSE IF O=9 THEN BEGIN IF D=Plus THEN BEGIN S:=''; I:=My_Col; REPEAT S:=S+' '; I:=I+1; UNTIL I MOD 8=1; END ELSE S:=''; END ELSE CASE O OF 0: S:=''; 1: S:=''; 2: S:=''; 3: S:=''; 4: S:=''; 5: S:=''; 6: S:=''; 7: S:=''; 8: S:=''; 9: S:=''; 10: S:=''; 11: S:=''; 12: S:=''; 13: S:=''; 14: S:=''; 15: S:=''; 16: S:=''; 17: S:=''; 18: S:=''; 19: S:=''; 20: S:=''; 21: S:=''; 22: S:=''; 23: S:=''; 24: S:=''; 25: S:=''; 26: S:=''; 27: S:=''; 28: S:=''; 29: S:=''; 30: S:=''; 31: S:=''; 127: S:=''; 128: S:='<128>'; 129: S:='<129>'; 130: S:='<130>'; 131: S:='<131>'; 132: S:=''; 133: S:=''; 134: S:=''; 135: S:=''; 136: S:=''; 137: S:=''; 138: S:=''; 139: S:=''; 140: S:=''; 141: S:=''; 142: S:=''; 143: S:=''; 144: S:=''; 145: S:=''; 146: S:=''; 147: S:=''; 148: S:=''; 149: S:=''; 150: S:=''; 151: S:=''; 152: S:='<152>'; 153: S:='<153>'; 154: S:='<154>'; 155: S:=''; 156: S:=''; 157: S:=''; 158: S:=''; 159: S:=''; 160: S:='<160>'; 255: S:='<255>'; END; END; PROCEDURE Fill_Screen; {Fills the screen with data from position First_Pos} LABEL 1; VAR Save_Line, Save_Col, Save_Save_Col, Last: INTEGER; C, My_Char, His_Char: CHAR; S: String; Blank: BOOLEAN; BEGIN Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=First_Line; My_Col:=First_Col; Blank:=My_Col>Last_Col[My_Line]; Buf_Goto(Main,First_Pos); WITH Main DO BEGIN WHILE Pos<=Bufsize DO BEGIN IF Memptr>Memsize THEN BEGIN IF Memmax-MemsizeC THEN BEGIN His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN IF His_Char=' ' THEN BEGIN Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; END; Last_Col[My_Line]:=My_Col; END; My_Col:=My_Col+1; IF (My_Line>=Bott_Line) AND (My_Col>Bott_Col) THEN GOTO 1; END ELSE BEGIN IF C=''(128)'' THEN BEGIN My_Line:=My_Line+1; IF After_Got=My_Line-Save_Line-1 THEN BEGIN After_Got:=After_Got+1; After_Pos[After_Got]:=Pos; END; IF My_Line>Maxlines THEN GOTO 1; My_Col:=1; Blank:=My_Col>Last_Col[My_Line]; END ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; END ELSE BEGIN IF C IN Printable THEN BEGIN IF My_Col<=Maxcol THEN BEGIN My_Char:=My_Screen[My_Line,My_Col]; IF My_Char<>C THEN BEGIN His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=C; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); His_Screen[His_Line,His_Col]:=C; Put_Char(C); His_Col:=His_Col+1; END ELSE BEGIN IF His_Char=My_Char THEN BEGIN Any_Changes:=TRUE; Changes[My_Line]:=Changes[My_Line]+1; END ELSE IF His_Char=C THEN Changes[My_Line]:=Changes[My_Line]-1; END; END; IF Last_Col[My_Line]<=My_Col THEN BEGIN Blank:=TRUE; Last_Col[My_Line]:=My_Col; END; END; My_Col:=My_Col+1; IF (My_Line>=Bott_Line) AND (My_Col>Bott_Col) THEN GOTO 1; END ELSE BEGIN IF C=''(128)'' THEN BEGIN IF My_Col<=Last_Col[My_Line] THEN BEGIN Save_Save_Col:=My_Col; Last:=Last_Col[My_Line]; IF (NOT Got_Char) AND (NOT Any_Changes) THEN BEGIN IF (My_Col<>His_Col) OR (My_Line<>His_Line) THEN OPT_Move_Cursor(My_Line,My_Col); Erase_Line; FOR My_Col:=Save_Save_Col TO Last DO BEGIN My_Char:=My_Screen[My_Line,My_Col]; IF My_Char<>' ' THEN BEGIN His_Char:=His_Screen[My_Line,My_Col]; My_Screen[My_Line,My_Col]:=' '; His_Screen[My_Line,My_Col]:=' '; END; END; END ELSE BEGIN REPEAT IF My_Screen[My_Line,My_Col]=' ' THEN My_Col:=My_Col+1 ELSE OPT_Put_Char(' '); UNTIL My_Col>Last; END; My_Col:=Save_Save_Col; Last_Col[My_Line]:=My_Col-1; END; My_Line:=My_Line+1; IF After_Got=My_Line-Save_Line-1 THEN BEGIN After_Got:=After_Got+1; After_Pos[After_Got]:=Pos; END; IF My_Line>Maxlines THEN GOTO 1; My_Col:=1; Blank:=My_Col>Last_Col[My_Line]; END ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; END; END; END; IF My_Col<>1 THEN BEGIN OPT_L_Erase; My_Line:=My_Line+1; My_Col:=1; END; IF My_Line<=Maxlines THEN OPT_Put_String('[EOB]'); WHILE My_Line<=Maxlines DO BEGIN OPT_L_Erase; My_Line:=My_Line+1; My_Col:=1; END; 1: Buf_Goto(Main,First_Pos); My_Line:=Save_Line; My_Col:=Save_Col; END; [GLOBAL] PROCEDURE Move_Got(L: INTEGER); {Adjusts the database of line positions by L lines} VAR I: INTEGER; BEGIN This_Line:=This_Line+L; IF L>0 THEN BEGIN IF Before_Got+L>Window THEN I:=Window-L ELSE I:=Before_Got; IF I>0 THEN I$MOVE(Before_Pos[1],Before_Pos[1+L],I); Before_Pos[L]:=This_Pos; FOR I:=1 TO L-1 DO Before_Pos[L-I]:=After_Pos[I]; This_Pos:=After_Pos[L]; I:=After_Got-L; IF I>0 THEN BEGIN I$Move(After_Pos[1+L],After_Pos[1],I); After_Got:=I; END ELSE After_Got:=0; IF Before_Got+LWindow THEN I:=Window-L ELSE I:=After_Got; IF I>0 THEN I$MOVE(After_Pos[1],After_Pos[1+L],I); After_Pos[L]:=This_Pos; FOR I:=1 TO L-1 DO After_Pos[L-I]:=Before_Pos[I]; This_Pos:=Before_Pos[L]; I:=Before_Got-L; IF I>0 THEN BEGIN I$Move(Before_Pos[1+L],Before_Pos[1],Before_Got-L); Before_Got:=I; END ELSE Before_Got:=0; IF After_Got+L0 THEN BEGIN IF After_Pos[After_Got]0 THEN Move_Got(Lines); END; PROCEDURE Find_This; {Finds a line that is too far up to be in the line database} BEGIN Before_Got:=0; After_Got:=0; New_Line:=1; This_Line:=1; This_Pos:=1; My_Pos:=1; Buf_Goto(Main,1); Goto_This; END; PROCEDURE Find_Pos; {Finds the right position within a line} BEGIN Buf_Goto(Main,This_Pos); My_Col:=1; WHILE Main.Pos<>New_Pos DO BEGIN C:=Buf_Get(Main); Char_Rep(ORD(C),S,Plus); My_Col:=My_Col+LENGTH(S); END; My_Pos:=Main.Pos; END; BEGIN New_Pos:=My_Pos+N; IF New_Pos<1 THEN New_Pos:=1 ELSE IF New_Pos>Main.Bufsize THEN New_Pos:=Main.Bufsize+1; Move:=My_Pos-New_Pos; IF New_Pos=My_Pos THEN GOTO 1; IF N<0 THEN BEGIN IF This_Pos<=New_Pos THEN BEGIN Buf_Goto(Main,My_Pos); WHILE New_Pos<>Main.Pos DO BEGIN C:=Buf_B_Get(Main); IF C=''(9)'' THEN Find_Pos ELSE BEGIN Char_Rep(ORD(C),S,Minus); My_Col:=My_Col-LENGTH(S); END; END; My_Pos:=Main.Pos; END ELSE IF Before_Got>0 THEN BEGIN IF Before_Pos[Before_Got]<=New_Pos THEN BEGIN Good_Enough:=TRUE; Line_Move:=1; WHILE Good_Enough DO BEGIN IF Before_Pos[Line_Move]<=New_Pos THEN Good_Enough:=FALSE ELSE Line_Move:=Line_Move+1; END; Move_Got(-Line_Move); New_Line:=My_Line-Line_Move; Scroll:=Cursor_Top-New_Line; IF New_Line>=Cursor_Top THEN BEGIN My_Line:=New_Line; Find_Pos; END ELSE BEGIN IF This_Line<=Cursor_Top THEN BEGIN IF This_Line<>New_Line THEN BEGIN My_Line:=This_Line; Scroll:=This_Line-New_Line; IF Scroll=Cursor_Middle-1 THEN BEGIN My_Line:=Cursor_Middle; IF My_Line=1 THEN Fill_Screen(1,1,Scroll+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); Find_Pos; END ELSE IF This_Line=Cursor_Middle THEN My_Line:=Cursor_Middle ELSE My_Line:=This_Line; IF My_Line=1 THEN Fill_Screen(1,1,Maxlines+1,1,1) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); Find_Pos; END; END ELSE BEGIN Find_This; IF This_Line>=Cursor_Middle THEN My_Line:=Cursor_Middle ELSE My_Line:=This_Line; IF My_Line=1 THEN Fill_Screen(1,1,Maxlines+1,1,1) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); Find_Pos; END; END ELSE BEGIN IF After_Got>0 THEN BEGIN IF After_Pos[After_Got]>=New_Pos THEN BEGIN IF After_Pos[1]>New_Pos THEN Line_Move:=0 ELSE BEGIN Line_Move:=2; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Line_Move>After_Got THEN Good_Enough:=FALSE ELSE IF After_Pos[Line_Move]>New_Pos THEN Good_Enough:=FALSE ELSE Line_Move:=Line_Move+1; END; Line_Move:=Line_Move-1; END; New_Line:=My_Line+Line_Move; IF Line_Move=0 THEN BEGIN Buf_Goto(Main,My_Pos); WHILE New_Pos<>Main.Pos DO BEGIN C:=Buf_Get(Main); Char_Rep(ORD(C),S,Plus); My_Col:=My_Col+LENGTH(S); END; My_Pos:=Main.Pos; END ELSE BEGIN Move_Got(Line_Move); IF My_Line+Line_Move<=Cursor_Bottom THEN BEGIN My_Line:=New_Line; Find_Pos; END ELSE BEGIN My_Line:=Cursor_Bottom; Scroll:=New_Line-Cursor_Bottom; IF ScrollLines_Left THEN Fill_Screen(Maxlines-Scroll,1,Maxlines+1,1, Before_Pos[Scroll-Lines_Left]) ELSE IF After_Got>=Lines_Left-Scroll THEN Fill_Screen(Maxlines-Scroll,1,Maxlines+1,1, After_Pos[Lines_Left-Scroll]) ELSE IF After_Got=0 THEN Fill_Screen(My_Line,1,Maxlines+1,1,This_Pos) ELSE Fill_Screen(My_Line+After_Got,1,Maxlines+1,1, After_Pos[After_Got]); END ELSE BEGIN My_Line:=Cursor_Middle; IF My_Line=1 THEN Fill_Screen(1,1,Scroll+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); END; Find_Pos; END; END; END ELSE BEGIN New_Line:=This_Line; Buf_Goto(Main,My_Pos); Goto_This; This_Line:=New_Line; My_Line:=Cursor_Middle; IF My_Line=1 THEN Fill_Screen(1,1,Scroll+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); Find_Pos; END; END ELSE BEGIN New_Line:=This_Line; Buf_Goto(Main,My_Pos); Goto_This; This_Line:=New_Line; My_Line:=Cursor_Middle; IF My_Line=1 THEN Fill_Screen(1,1,Scroll+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); Find_Pos; END; END; 1: END; [GLOBAL] PROCEDURE Mark_Adj(L:INTEGER); {Makes sure that the select point and marks point at the same place} VAR I: INTEGER; BEGIN IF L>0 THEN BEGIN FOR I:=1 TO Maxmarks+2 DO IF Marks[I]>=My_Pos THEN Marks[I]:=Marks[I]+L; IF Sel_Pos>=My_Pos THEN Sel_Pos:=Sel_Pos+L; END ELSE BEGIN FOR I:=1 TO Maxmarks+2 DO IF Marks[I]>My_Pos THEN BEGIN IF Marks[I]<=My_Pos-L THEN Marks[I]:=My_Pos ELSE Marks[I]:=Marks[I]+L; END; IF Sel_Pos>My_Pos THEN BEGIN IF Sel_Pos<=My_Pos+L THEN Sel_Pos:=My_Pos ELSE Sel_Pos:=Sel_Pos+L; END; END; END; [GLOBAL] PROCEDURE Pad_Adj(P_Start, P_Length: INTEGER); {Adjusts all pointers into the keypad buffer} VAR I: INTEGER; PROCEDURE One_Pad_Adj(VAR A_Start: INTEGER); {Adjusts one pointer into the pad buffer} BEGIN IF A_Start>P_Start THEN A_Start:=A_Start+P_Length; END; BEGIN IF P_Start>0 THEN BEGIN FOR I:=0 TO 45 DO BEGIN One_Pad_Adj(Pad_Start[I]); One_Pad_Adj(G_Pad_Start[I]); END; FOR I:=0 TO 159 DO BEGIN One_Pad_Adj(Cont_Start[I]); One_Pad_Adj(G_Cont_Start[I]); END; FOR I:=33 TO 255 DO One_Pad_Adj(G_Char_Start[I]); One_Pad_Adj(B_Char); One_Pad_Adj(B_Word); One_Pad_Adj(B_Line); One_Pad_Adj(B_Paste); One_Pad_Adj(B_Delete); One_Pad_Adj(B_Search); One_Pad_Adj(B_Subs); END; END; [GLOBAL] PROCEDURE Move_Into(VAR Start, Size: INTEGER); {Moves data from the main buffer into the pad buffer (usually a delete buffer)} VAR Del_Lines: INTEGER; Good_Enough: BOOLEAN; BEGIN Del_Lines:=0; IF Start<>0 THEN BEGIN Buf_Goto(Pad,Start); Buf_Remove(Pad,Size); Pad_Adj(Start,-Size); END; Buf_Goto(Pad,Pad.Bufsize+1); Start:=Pad.Pos; IF (My_Pos<>This_Pos) AND (Ent_End=Main.Bufsize+1) THEN Ent_End:=Ent_End-1; Size:=Ent_End-Ent_Begin; IF Size>=0 THEN BEGIN Good_Enough:=TRUE; Del_Lines:=0; WHILE Good_Enough DO BEGIN IF Del_Lines0 THEN BEGIN IF After_Got>Del_Lines THEN BEGIN I$Move(After_Pos[Del_Lines+1],After_Pos[1],After_Got-Del_Lines); After_Got:=After_Got-Del_Lines; END ELSE After_Got:=0; END; IF After_Got>0 THEN I$Add(After_Pos[1],After_Got,-Size); Buf_Goto(Main,Ent_Begin); Buf_Copy(Main,Pad,Size); Buf_Goto(Main,Ent_Begin); Buf_Remove(Main,Size); Mark_Adj(-Size); IF Del_Lines>0 THEN BEGIN OPT_Close_Lines(Del_Lines); IF My_Col=1 THEN BEGIN IF My_Line+Del_Lines0 THEN Fill_Screen(My_Line+After_Got,1,Maxlines+1,1,After_Pos[After_Got]) ELSE Fill_Screen(My_Line,My_Col,Maxlines+1,1,My_Pos); END ELSE BEGIN Fill_Screen(My_Line,1,My_Line+1,1,This_Pos); Fill_Screen(Maxlines-Del_Lines,1,Maxlines+1,1, After_Pos[Maxlines-My_Line-Del_Lines]); END; END ELSE Fill_Screen(My_Line,1,Maxlines+1,1,This_Pos); END ELSE BEGIN IF My_Line+Del_Lines0 THEN Fill_Screen(My_Line+After_Got,1,Maxlines+1,1,After_Pos[After_Got]) ELSE Fill_Screen(My_Line,My_Col,Maxlines+1,1,My_Pos); END ELSE BEGIN Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); Fill_Screen(Maxlines-Del_Lines,1,Maxlines+1,1, After_Pos[Maxlines-My_Line-Del_Lines]); END; END ELSE Fill_Screen(My_Line,My_Col,Maxlines+1,1,My_Pos); END; END ELSE Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); END; END; [GLOBAL] PROCEDURE Get_Into(VAR Start, Size: INTEGER); {Moves data from the main buffer into the pad buffer (usually a delete buffer)} BEGIN IF Start<>0 THEN BEGIN Buf_Goto(Pad,Start); Buf_Remove(Pad,Size); Pad_Adj(Start,-Size); END; Buf_Goto(Pad,Pad.Bufsize+1); Start:=Pad.Pos; Size:=Ent_End-Ent_Begin; IF Size>=0 THEN BEGIN Buf_Goto(Main,Ent_Begin); Buf_Copy(Main,Pad,Size); END; END; [GLOBAL] PROCEDURE Ins_Char(C: CHAR); {Inserts a character into the buffer, updates the screen database and insert the character in the main buffer. This is the routine that does it all for inserting characters, the others bypass some of the logic for performance reasons} VAR S: String; I, L, Save_Pos: INTEGER; My_C: CHAR; Good_Enough: BOOLEAN; BEGIN IF Main.Pos>Main.Bufsize THEN IF C<>''(128)'' THEN BEGIN Ins_Char(''(128)''); Move_Cursor(-1); END; IF C=''(128)'' THEN BEGIN Buf_Put(Main,C); IF After_Got1 THEN BEGIN I$Move(After_Pos[1],After_Pos[2],After_Got-1); I$Add(After_Pos[2],After_Got-1,1); END; Mark_Adj(1); After_Pos[1]:=Main.Pos; OPT_Open_Lines(1); Move_Cursor(1); END ELSE BEGIN Buf_Put(Main,C); IF After_Got>0 THEN I$Add(After_Pos[1],After_Got,1); Mark_Adj(1); IF C IN Printable THEN BEGIN IF My_Col>Last_Col[My_Line] THEN BEGIN OPT_Put_Char(C); My_Pos:=My_Pos+1; END ELSE BEGIN Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); Move_Cursor(1); END; END ELSE BEGIN Char_Rep(ORD(C),S,Plus); L:=LENGTH(S); IF My_Col>Last_Col[My_Line] THEN BEGIN OPT_Put_String(S); My_Pos:=My_Pos+1; END ELSE BEGIN Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); Move_Cursor(1); END; END; IF Right_Margin>0 THEN IF My_Col>Right_Margin THEN BEGIN Save_Pos:=My_Pos; My_C:=Buf_B_Get(Main); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Main.Pos=1 THEN Good_Enough:=FALSE ELSE BEGIN My_C:=Buf_B_Get(Main); IF My_C=''(128)'' THEN BEGIN Buf_Goto(Main,Save_Pos); Good_Enough:=FALSE; END ELSE IF My_C IN Word_Delim THEN BEGIN L:=Save_Pos-Main.Pos-1; Move_Cursor(-L); Ins_Char(''(128)''); IF Left_Margin>0 THEN BEGIN FOR I:=1 TO Left_Margin DIV 8 DO Ins_Char(''(9)''); FOR I:=My_Col TO Left_Margin DO Ins_Char(' '); END; Move_Cursor(L); Good_Enough:=FALSE; END; END; END; END; END; END; [GLOBAL] PROCEDURE Ins_A_Char(C: CHAR); {Inserts a character into the buffer and updates the screen database, but doesn't put it into the main buffer. We know we are at the end of a line} VAR S: String; I, L, Save_Pos: INTEGER; My_C: CHAR; Good_Enough: BOOLEAN; BEGIN IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); L:=LENGTH(S); OPT_Put_String(S); END; IF Right_Margin>0 THEN IF My_Col>Right_Margin THEN BEGIN WITH Com DO BEGIN Buf_Goto(Com,1); Buf_Copy(Com,Main,Bufsize); I$Add(After_Pos[1],After_Got,Bufsize); Mark_Adj(Bufsize); My_Pos:=My_Pos+Bufsize; Buf_Reset(Com); END; Save_Pos:=My_Pos; My_C:=Buf_B_Get(Main); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Main.Pos=1 THEN Good_Enough:=FALSE ELSE BEGIN My_C:=Buf_B_Get(Main); IF My_C=''(128)'' THEN BEGIN Buf_Goto(Main,Save_Pos); Good_Enough:=FALSE; END ELSE IF My_C IN Word_Delim THEN BEGIN L:=Save_Pos-Main.Pos-1; Move_Cursor(-L); Ins_Char(''(128)''); IF Left_Margin>0 THEN BEGIN FOR I:=1 TO Left_Margin DIV 8 DO Ins_Char(''(9)''); FOR I:=My_Col TO Left_Margin DO Ins_Char(' '); END; Move_Cursor(L); Good_Enough:=FALSE; END; END; END; END; END; [GLOBAL] PROCEDURE Ins_Q_Char(C: CHAR); {Inserts a character in the screen database but defers the insertion in the main buffer. The character is not echoed because we know that we read it with echo turned on} VAR I: INTEGER; S: String; BEGIN IF C IN Printable THEN BEGIN IF My_Col<=Maxcol THEN BEGIN My_Screen[My_Line,My_Col]:=C; His_Screen[My_Line,My_Col]:=C; Last_Col[My_Line]:=My_Col; His_Col:=His_Col+1; END; My_Col:=My_Col+1; END ELSE BEGIN Char_Rep(ORD(C),S,Plus); FOR I:=1 TO LENGTH(S) DO Ins_Q_Char(S[I]); END; END; [GLOBAL] PROCEDURE Error(S:String);FORWARD; [GLOBAL] PROCEDURE Move_From(VAR B_Buffer:Buffer; {Moves data from the pad buffer into the main buffer} Start, Size: INTEGER); VAR Del_Lines, New_Pos: INTEGER; Good_Enough: BOOLEAN; BEGIN Del_Lines:=0; IF Start=0 THEN Error('Buffer Empty') ELSE BEGIN IF Main.Pos>Main.Bufsize THEN BEGIN Buf_Goto(B_Buffer,Start+Size-1); IF Buf_Get(B_Buffer)<>''(128)'' THEN BEGIN Ins_Char(''(128)''); Move_Cursor(-1); END; END; Buf_Goto(B_Buffer,Start); Buf_Copy(B_Buffer,Main,Size); Mark_Adj(Size); Move:=Size; IF After_Got>0 THEN I$Add(After_Pos[1],After_Got,Size); Buf_Goto(Main,My_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN New_Pos:=Buf_Find(Main,''(128)''); IF (New_Pos=0) OR (New_Pos>My_Pos+Size) THEN Good_Enough:=FALSE ELSE BEGIN Del_Lines:=Del_Lines+1; IF After_Got0 THEN BEGIN OPT_Open_Lines(Del_Lines); IF My_Line+Del_Lines>Maxlines THEN Fill_Screen(My_Line,My_Col,Maxlines+1,1,My_Pos) ELSE Fill_Screen(My_Line,My_Col,My_Line+Del_Lines+1,1,My_Pos); END ELSE Fill_Screen(My_Line,My_Col,My_Line+1,1,My_Pos); IF Def_Direction=Plus THEN Move_Cursor(Size); END; END; [GLOBAL] FUNCTION Get_C_Char: CHAR; {Gets a single character from the terminal. If none are waiting we do a screen update} VAR Temp_Line, Temp_Col: INTEGER; My_C: CHAR; BEGIN WHILE In_Index>=In_Size DO BEGIN IF Recover_Flag THEN BEGIN IF EOF(Journal_File) THEN BEGIN TRUNCATE(Journal_File); T$Start(In_Buffer,Rec_Length); Recover_Flag:=FALSE; Journal_Length:=0; IF NOT Got_Char THEN BEGIN OPT_Update(1,Maxlines); Out_Zap; END; END ELSE BEGIN OPT_Update(1,Maxlines); Out_Zap; Any_Changes:=TRUE; READ(Journal_File,Journal_Rec); In_Index:=0; In_Size:=LENGTH(Journal_Rec); L$Move(Journal_Rec.BODY,Char_Buffer[1],In_Size); END; END ELSE BEGIN IF NOT Got_Char THEN BEGIN OPT_Update(1,Maxlines); Out_Zap; END; In_Size:=T$Get; IF Ctrlc_Flag THEN BEGIN Ctrlc_Flag:=FALSE; In_Size:=1; In_Buffer[1]:=CHR(3); His_Line:=Maxlines+1; FOR Temp_Line:=1 TO Maxlines DO BEGIN Changes[Temp_Line]:=0; FOR Temp_Col:=1 TO Maxcol DO BEGIN My_C:=My_Screen[Temp_Line,Temp_Col]; His_Screen[Temp_Line,Temp_Col]:=' '; IF My_C<>' ' THEN BEGIN Any_Changes:=TRUE; Changes[Temp_Line]:=Changes[Temp_Line]+1; END; END; END; Any_Changes:=TRUE; Clear_Screen; OPT_Update(1,Maxlines); Out_Zap; Error('Control C Typed'); END; Char_Buffer:=In_Buffer; IF Do_Echo THEN BEGIN Echo:=TRUE; Do_Echo:=FALSE; END; IF Echo THEN BEGIN IF (In_Size<>1) OR (NOT (Char_Buffer[1] IN Printable)) THEN T$Startone(In_Buffer,Rec_Length); END ELSE T$Startone(In_Buffer,Rec_Length); In_Index:=0; IF Journal_Flag THEN BEGIN IF In_Size+Journal_Length>256 THEN BEGIN S$Move(Journal_Body[1],Journal_Rec.BODY,Journal_Length); WRITE(Journal_File,Journal_Rec,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Writing Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; C$Move(Char_Buffer[1],Journal_Body[Journal_Length+1],In_Size); Journal_Length:=Journal_Length+In_Size; IF Com_Begin AND (Journal_Length>32) THEN BEGIN Journal_Rec.LENGTH:=Journal_Length; S$Move(Journal_Body[1],Journal_Rec.BODY,Journal_Length); WRITE(Journal_File,Journal_Rec,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Writing Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; END; END; END; In_Index:=In_Index+1; Get_C_Char:=Char_Buffer[In_Index]; END; [GLOBAL] FUNCTION Get_Key(VAR C: CHAR;VAR C_Index: INTEGER): Char_Type; {Reads a sequence of characters from the terminal and tries to figure out what key was pressed} VAR C_Ord, Next_Ord: INTEGER; Next_C: CHAR; PROCEDURE Key_Get_Pad(G_Type: Char_Type;G_Index: INTEGER); {Sets the return values} BEGIN Get_Key:=G_Type; C_Index:=G_Index; END; PROCEDURE Do_Get; {Reads characters and tries to figure out what key was pressed} BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C_Ord=27 THEN BEGIN Com_Begin:=FALSE; C:=Get_C_Char; C_Ord:=ORD(C); CASE Term_Type OF VT52: BEGIN IF C IN ['A'..'D'] THEN BEGIN C_Ord:=C_Ord-ORD('A')+12; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C IN ['P'..'S'] THEN BEGIN IF C='P' THEN BEGIN Gold:=TRUE; Do_Get; END ELSE IF C='S' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,17) ELSE Key_Get_Pad(Ch_Pad,17); END ELSE BEGIN C_Ord:=C_Ord-ORD('Q')+10; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END; END ELSE IF C='?' THEN BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C IN ['p'..'y'] THEN BEGIN C_Ord:=C_Ord-112; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C='m' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,18) ELSE Key_Get_Pad(Ch_Pad,18); END ELSE IF C='l' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,19) ELSE Key_Get_Pad(Ch_Pad,19); END ELSE IF C='n' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,16) ELSE Key_Get_Pad(Ch_Pad,16); END ELSE IF C='M' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,21) ELSE Key_Get_Pad(Ch_Pad,21); END ELSE Get_Key:=Ch_Undef; END ELSE IF C_Ord=27 THEN BEGIN Key_Get_Pad(Ch_Cont,27); END ELSE Get_Key:=Ch_Undef; END; VT100,VT102,VK100,VT200: BEGIN IF C='[' THEN BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C IN ['A'..'D'] THEN BEGIN C_Ord:=C_Ord-ORD('A')+12; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C IN ['1'..'6'] THEN BEGIN Next_C:=Get_C_Char; Next_Ord:=ORD(Next_C); IF Next_C='~' THEN BEGIN C_Ord:=C_Ord-ORD('1')+22; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF (Next_C IN ['0'..'9']) AND (Get_C_Char='~') THEN BEGIN CASE C OF '1': BEGIN IF Next_C IN ['7'..'9'] THEN BEGIN Next_Ord:=Next_Ord-ORD('7')+28; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; '2': BEGIN IF Next_C IN ['0'..'9'] THEN BEGIN Next_Ord:=Next_Ord-ORD('0')+31; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; '3': BEGIN IF Next_C IN ['1'..'4'] THEN BEGIN Next_Ord:=Next_Ord-ORD('1')+42; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; END; END; END; END ELSE IF C='O' THEN BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C IN ['A'..'D'] THEN BEGIN C_Ord:=C_Ord-ORD('A')+12; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C IN ['P'..'S'] THEN BEGIN IF C='P' THEN BEGIN Gold:=TRUE; Do_Get; END ELSE IF C='S' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,17) ELSE Key_Get_Pad(Ch_Pad,17); END ELSE BEGIN C_Ord:=C_Ord-ORD('Q')+10; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END; END ELSE IF C IN ['p'..'y'] THEN BEGIN C_Ord:=C_Ord-112; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C='m' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,18) ELSE Key_Get_Pad(Ch_Pad,18); END ELSE IF C='l' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,19) ELSE Key_Get_Pad(Ch_Pad,19); END ELSE IF C='n' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,16) ELSE Key_Get_Pad(Ch_Pad,16); END ELSE IF C='M' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,21) ELSE Key_Get_Pad(Ch_Pad,21); END ELSE Get_Key:=Ch_Undef; END ELSE IF C_Ord=27 THEN BEGIN Key_Get_Pad(Ch_Cont,27); END ELSE Get_Key:=Ch_Undef; END; END; END ELSE IF (C_Ord=155) AND (Term_Type=VT200) THEN BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C IN ['A'..'D'] THEN BEGIN C_Ord:=C_Ord-ORD('A')+12; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C IN ['1'..'6'] THEN BEGIN Next_C:=Get_C_Char; Next_Ord:=ORD(Next_C); IF Next_C='~' THEN BEGIN C_Ord:=C_Ord-ORD('1')+22; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF (Next_C IN ['0'..'9']) AND (Get_C_Char='~') THEN BEGIN CASE C OF '1': BEGIN IF Next_C IN ['7'..'9'] THEN BEGIN Next_Ord:=Next_Ord-ORD('7')+28; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; '2': BEGIN IF Next_C IN ['0'..'9'] THEN BEGIN Next_Ord:=Next_Ord-ORD('0')+31; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; '3': BEGIN IF Next_C IN ['1'..'4'] THEN BEGIN Next_Ord:=Next_Ord-ORD('1')+42; IF Gold THEN Key_Get_Pad(Ch_G_Pad,Next_Ord) ELSE Key_Get_Pad(Ch_Pad,Next_Ord); END; END; END; END; END; END ELSE IF (Term_Type=VT200) AND (C_Ord=143) THEN BEGIN C:=Get_C_Char; C_Ord:=ORD(C); IF C IN ['A'..'D'] THEN BEGIN C_Ord:=C_Ord-ORD('A')+12; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C IN ['P'..'S'] THEN BEGIN IF C='P' THEN BEGIN Gold:=TRUE; Do_Get; END ELSE IF C='S' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,17) ELSE Key_Get_Pad(Ch_Pad,17); END ELSE BEGIN C_Ord:=C_Ord-ORD('Q')+10; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END; END ELSE IF C IN ['p'..'y'] THEN BEGIN C_Ord:=C_Ord-112; IF Gold THEN Key_Get_Pad(Ch_G_Pad,C_Ord) ELSE Key_Get_Pad(Ch_Pad,C_Ord); END ELSE IF C='m' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,18) ELSE Key_Get_Pad(Ch_Pad,18); END ELSE IF C='l' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,19) ELSE Key_Get_Pad(Ch_Pad,19); END ELSE IF C='n' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,16) ELSE Key_Get_Pad(Ch_Pad,16); END ELSE IF C='M' THEN BEGIN IF Gold THEN Key_Get_Pad(Ch_G_Pad,21) ELSE Key_Get_Pad(Ch_Pad,21); END ELSE Get_Key:=Ch_Undef; END ELSE IF C_Ord IN [0..31,127..159] THEN BEGIN Com_Begin:=FALSE; IF Gold THEN Key_Get_Pad(Ch_G_Cont,C_Ord) ELSE Key_Get_Pad(Ch_Cont,C_Ord); END ELSE IF (NOT (C_Ord IN [0..31,127..159])) AND Gold THEN BEGIN Com_Begin:=FALSE; IF (C_Ord>=97) AND (C_Ord<=122) THEN C_Ord:=C_Ord-32; Key_Get_Pad(Ch_G_Char,C_Ord); END ELSE Get_Key:=Ch_Char; END; BEGIN Working:=1; Gold:=FALSE; Do_Get; END; [GLOBAL] FUNCTION Get_Input: BOOLEAN; {Gets input from the terminal and inserts it in the command buffer after printing a prompt} LABEL 1; VAR C: CHAR; C_Type: Char_Type; C_Index: INTEGER; Com_Pos, Com_Col, Save_Line, Save_Col, Tmp_Col, I: INTEGER; C_ORD: INTEGER; S: STRING; Enter: BOOLEAN; PROCEDURE Input_Get_Pad(P_Start, P_Length: INTEGER); {Inserts the string that a key has been defined as} VAR I: INTEGER; C: CHAR; BEGIN IF P_Start<>0 THEN BEGIN Buf_Goto(Pad,P_Start); FOR I:=1 TO P_Length DO BEGIN C:=Buf_Get(Pad); IF (I<>P_Length) OR (C<>'.') THEN BEGIN Buf_Put(Com,C); IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; END; END; END; BEGIN Get_Input:=TRUE; Enter:=FALSE; Com_Pos:=Com.Pos; Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C<>''(39)'' THEN Buf_Goto(Com,Com.Pos-1) ELSE BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); REPEAT IF Com.Pos>Com.Bufsize THEN BEGIN Get_Input:=FALSE; My_Line:=Save_Line; My_Col:=Save_Col; GOTO 1; END; C:=Buf_Del(Com); IF C<>''(39)'' THEN BEGIN IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; UNTIL C=''(39)''; END; END; Com_Col:=My_Col; REPEAT C_Type:=Get_Key(C,C_Index); C_Ord:=ORD(C); CASE C_Type OF Ch_Char: BEGIN IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(C_ORD,S,Plus); OPT_Put_String(S); END; Buf_Put(Com,C); END; Ch_G_Char: Input_Get_Pad(G_Char_Start[C_Index],G_Char_Length[C_Index]); Ch_Pad: IF C_Index IN [21,40] THEN Enter:=TRUE ELSE Input_Get_Pad(Pad_Start[C_Index],Pad_Length[C_Index]); Ch_G_Pad: Input_Get_Pad(G_Pad_Start[C_Index],G_Pad_Length[C_Index]); Ch_Cont: BEGIN IF C_ORD=21 THEN BEGIN Tmp_Col:=My_Col; My_Col:=Com_Col; Buf_Goto(Com,Com_Pos); WHILE My_Col<>Tmp_Col DO BEGIN C:=Buf_Del(Com); IF C IN Printable THEN OPT_Put_Char(' ') ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; My_Line:=Save_Line; My_Col:=Save_Col; Get_Input:=FALSE; Error('Input Aborted'); GOTO 1; END ELSE IF C_ORD=127 THEN BEGIN IF Com.Pos>Com_Pos THEN BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); IF C IN Printable THEN BEGIN My_Col:=My_Col-1; OPT_Put_Char(' '); My_Col:=My_Col-1; END ELSE BEGIN IF C=''(9)'' THEN S:='' ELSE Char_Rep(ORD(C),S,Plus); My_Col:=My_Col-LENGTH(S); FOR I:=1 TO LENGTH(S) DO OPT_Put_Char(' '); My_Col:=My_Col-LENGTH(S); END; END; END ELSE IF C_ORD=13 THEN Enter:=TRUE ELSE BEGIN IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN IF C=''(9)'' THEN S:='' ELSE Char_Rep(C_ORD,S,Plus); OPT_Put_String(S); END; Buf_Put(Com,C); END; END; Ch_G_Cont: Input_Get_Pad(G_Cont_Start[C_Index],G_Cont_Length[C_Index]); Ch_Undef: END; UNTIL Enter; My_Line:=Save_Line; My_Col:=Save_Col; 1: END; [GLOBAL] FUNCTION Get_Inkey: BOOLEAN; {Gets a key from the terminal and translates it into it's mnemonic} LABEL 1; VAR C: CHAR; C_Type: Char_Type; C_Index: INTEGER; Save_Line, Save_Col: INTEGER; S: String; BEGIN Get_Inkey:=TRUE; S:=''; Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C<>''(39)'' THEN Buf_Goto(Com,Com.Pos-1) ELSE BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); REPEAT IF Com.Pos>Com.Bufsize THEN BEGIN Get_Inkey:=FALSE; My_Line:=Save_Line; My_Col:=Save_Col; GOTO 1; END; C:=Buf_Del(Com); IF C<>''(39)'' THEN BEGIN IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); OPT_Put_String(S); END; END; UNTIL C=''(39)''; END; END; C_Type:=Get_Key(C,C_Index); CASE C_Type OF Ch_Char: Get_Inkey:=FALSE; Ch_G_Char: BEGIN WRITEV(S,C_Index:1); S:='GK'+S; END; Ch_Pad: BEGIN WRITEV(S,C_Index:1); S:='P'+S; END; Ch_G_Pad: BEGIN WRITEV(S,C_Index:1); S:='GP'+S; END; Ch_Cont: BEGIN WRITEV(S,C_Index:1); S:='C'+S; END; Ch_G_Cont: BEGIN WRITEV(S,C_Index:1); S:='GC'+S; END; Ch_Undef: Get_Inkey:=FALSE; END; IF LENGTH(S)<>0 THEN Buf_Put_S(Com,S); My_Line:=Save_Line; My_Col:=Save_Col; 1: END; PROCEDURE Error; {Signals an error to the user and to SEDT} VAR Save_Line, Save_Col: INTEGER; BEGIN IF NOT Error_Flag THEN BEGIN Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; OPT_Update(1,Maxlines); CASE Term_Type OF VT100,VT102,VK100: Escape('[7m'); VT200: Put_String(''(155)'7m'); END; OPT_Put_String(S); OPT_Update(1,Maxlines); CASE Term_Type OF VT100,VT102,VK100: Escape('[0m'); VT200: Put_String(''(155)'0m'); END; Put_Char(''(7)''); Out_Zap; Error_Flag:=TRUE; My_Line:=Save_Line; My_Col:=Save_Col; END; END; [GLOBAL] PROCEDURE Get_Pad(P_Start, P_Length: INTEGER); {Gets the definition of a key into the command buffer. It handles ! and ?} VAR I, G_Pos: INTEGER; Inputs: BOOLEAN; C: CHAR; BEGIN IF P_Start<>0 THEN BEGIN G_Pos:=Com.Pos; Buf_Goto(Pad,P_Start); FOR I:=1 TO P_Length DO BEGIN C:=Buf_Get(Pad); IF C IN ['?','!'] THEN Inputs:=TRUE; IF (I<>P_Length) OR (C<>'.') THEN Buf_Put(Com,C); END; IF C='.' THEN Com_End:=TRUE; IF Inputs THEN BEGIN Buf_Goto(Com,G_Pos); WHILE (Com.Pos<=Com.Bufsize) AND (NOT Error_Flag) DO BEGIN C:=Buf_Get(Com); IF C='?' THEN BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); IF NOT Get_Input THEN Error('No Data After ?');; END ELSE IF C='!' THEN BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); IF NOT Get_Inkey THEN Error('No Data After !');; END; END; END; END ELSE Error('No Definition For This Key');; END; [GLOBAL] FUNCTION Com_Ch_Get: CHAR; {Gets a character from the command buffer} VAR C: CHAR; S_Pos: INTEGER; Rep: String; BEGIN C:=Buf_Get(Com); IF C='%' THEN BEGIN IF Com.Pos=Com.Bufsize+1 THEN Error('No Data After %') ELSE BEGIN Buf_Goto(Com,Com.Pos-1); S_Pos:=Com.Pos; C:=Buf_Del(Com); C:=Buf_Del(Com); IF (C='L') OR (C='l') THEN WRITEV(Rep,This_Line:1) ELSE IF (C='C') OR (C='c') THEN WRITEV(Rep,My_Pos-This_Pos+1:1) ELSE IF (C='P') OR (C='p') THEN WRITEV(Rep,My_Pos:1) ELSE IF (C='M') OR (C='m') THEN WRITEV(Rep,Move:1) ELSE Error('Bad Argument For %'); IF NOT Error_Flag THEN BEGIN IF Rep[1]<>'-' THEN Rep:='+'+Rep; Buf_Put_S(Com,Rep); Buf_Goto(Com,S_Pos); C:=Buf_Get(Com); END; END; END; Com_Ch_Get:=C; END; [GLOBAL] FUNCTION Get_Command(S: String): BOOLEAN; {Searches for S in the valid commannd names} BEGIN Command:=C_ILL; CASE S[1] OF 'A': IF S='ADV' THEN Command:=C_ADV ELSE IF S='ASC' THEN Command:=C_ASC; 'B': IF S='BACK' THEN Command:=C_BACK; 'C': IF S='CB' THEN Command:=C_CB ELSE IF S='CEN' THEN Command:=C_CEN ELSE IF S='CGC' THEN Command:=C_CGC ELSE IF S='CM' THEN Command:=C_CM ELSE IF S='CT' THEN Command:=C_CT ELSE IF S='CUT' THEN Command:=C_CUT; 'D': IF S='DEFK' THEN Command:=C_DEFK ELSE IF S='DEL' THEN Command:=C_DEL ELSE IF S='DI' THEN Command:=C_DI; 'E': IF S='EB' THEN Command:=C_EB ELSE IF S='EX' THEN Command:=C_EX; 'F': IF S='FE' THEN Command:=C_FE ELSE IF S='FI' THEN Command:=C_FI ELSE IF S='FO' THEN Command:=C_FO ELSE IF S='FW' THEN Command:=C_FW; 'G': IF S='GET' THEN Command:=C_GET; 'H': IF S='HELP' THEN Command:=C_HELP; 'I': IF S='I' THEN Command:=C_I; 'K': IF S='KS' THEN Command:=C_KS; 'M': IF S='MARK' THEN Command:=C_MARK ELSE IF S='ML' THEN Command:=C_ML ELSE IF S='MODE' THEN Command:=C_MODE ELSE IF S='MR' THEN Command:=C_MR; 'P': IF S='PASTE' THEN Command:=C_PASTE; 'Q': IF S='QUIT' THEN Command:=C_QUIT; 'R': IF S='REF' THEN Command:=C_REF ELSE IF S='RES' THEN Command:=C_RES; 'S': IF S='SEL' THEN Command:=C_SEL ELSE IF S='SN' THEN Command:=C_SN ELSE IF S='SUB' THEN Command:=C_SUB ELSE IF S='STA' THEN Command:=C_STA; 'T': IF S='TAB' THEN Command:=C_TAB ELSE IF S='TAK' THEN Command:=C_TAK ELSE IF S='TC' THEN Command:=C_TC ELSE IF S='TD' THEN Command:=C_TD ELSE IF S='TF' THEN Command:=C_TF ELSE IF S='TI' THEN Command:=C_TI ELSE IF S='TN' THEN Command:=C_TN ELSE IF S='TS' THEN Command:=C_TS ELSE IF S='TW' THEN Command:=C_TW; 'U': IF S='UNDC' THEN Command:=C_UNDC ELSE IF S='UNDD' THEN Command:=C_UNDD ELSE IF S='UNDL' THEN Command:=C_UNDL ELSE IF S='UNDW' THEN Command:=C_UNDW; 'Z': IF S='Z' THEN Command:=C_Z; END; Get_Command:=Command<>C_ILL; END; [GLOBAL] PROCEDURE Word_End; {Finds the end of a word} VAR C_Count: INTEGER; Good_Enough, Word_End: BOOLEAN; C: Char; LABEL 1; BEGIN WHILE Ent_Count<>0 DO BEGIN Good_Enough:=TRUE; Word_End:=FALSE; C_Count:=0; WHILE Good_Enough Do BEGIN C_Count:=C_Count+1; IF Main.Pos<=Main.Bufsize THEN BEGIN C:=Buf_Get(Main); IF C IN Word_Delim THEN BEGIN Word_End:=TRUE; IF NOT (C IN [' ',''(9)'']) THEN IF C_Count<>1 THEN BEGIN Ent_End:=Main.Pos-1; Good_Enough:=FALSE; END; END ELSE IF Word_End THEN BEGIN Ent_End:=Main.Pos-1; Good_Enough:=FALSE; END; END ELSE BEGIN IF Ent_Count<>1 THEN Error('End Of Buffer Reached'); Good_Enough:=FALSE; Ent_End:=Main.Bufsize+1; END; END; Ent_Count:=Ent_Count-1; END; Ent_Pos:=Ent_End; 1: END; [GLOBAL] PROCEDURE Word_Begin; {Finds the beginning of a word} VAR Good_Enough, Word_End, Delim: BOOLEAN; C: Char; BEGIN IF My_Pos=1 THEN Error('Beginning Of Buffer Reached') ELSE BEGIN WHILE Ent_Count<>0 DO BEGIN Good_Enough:=TRUE; Word_End:=FALSE; Delim:=FALSE; WHILE Good_Enough Do BEGIN IF Main.Pos=1 THEN BEGIN IF Ent_Count<>1 THEN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; Good_Enough:=FALSE; END ELSE BEGIN C:=Buf_B_Get(Main); IF C IN Word_Delim THEN BEGIN IF (C<>' ') AND (C<>''(9)'') THEN BEGIN IF Word_End THEN BEGIN Ent_Begin:=Main.Pos+1; Good_Enough:=FALSE; END ELSE BEGIN Word_End:=TRUE; Delim:=TRUE; END; END ELSE IF Word_End THEN BEGIN Ent_Begin:=Main.Pos+1; Good_Enough:=FALSE; END; END ELSE IF Delim THEN BEGIN Ent_Begin:=Main.Pos+1; Good_enough:=FALSE; END ELSE Word_End:=TRUE; END; END; Ent_Count:=Ent_Count-1; END; Ent_Pos:=Ent_Begin; END; END; [GLOBAL] PROCEDURE Sen_End; {Finds the end of a sentence} VAR C_Count: INTEGER; Good_Enough, Sen_End: BOOLEAN; C: Char; LABEL 1; BEGIN WHILE Ent_Count<>0 DO BEGIN Good_Enough:=TRUE; Sen_End:=FALSE; C_Count:=0; WHILE Good_Enough Do BEGIN C_Count:=C_Count+1; IF Main.Pos<=Main.Bufsize THEN BEGIN C:=Buf_Get(Main); IF C IN ['.',';','!'] THEN BEGIN Sen_End:=TRUE; IF C<>' ' THEN IF C_Count<>1 THEN BEGIN Ent_End:=Main.Pos; Good_Enough:=FALSE; END; END ELSE IF Sen_End THEN BEGIN Ent_End:=Main.Pos; Good_Enough:=FALSE; END; END ELSE BEGIN IF Ent_Count<>1 THEN Error('End Of Buffer Reached'); Ent_End:=Main.Pos; Good_Enough:=FALSE; END; END; Ent_Count:=Ent_Count-1; END; Ent_Pos:=Ent_End; 1: END; [GLOBAL] PROCEDURE Sen_Begin; {Finds the beginning of a sentence} VAR Good_Enough, Sen_End, Sen_Delim: BOOLEAN; C: Char; LABEL 1; BEGIN IF My_Pos=1 THEN Error('Beginning Of Buffer Reached') ELSE BEGIN C:=Buf_B_Get(Main); WHILE Ent_Count<>0 DO BEGIN Good_Enough:=TRUE; Sen_End:=FALSE; Sen_Delim:=FALSE; WHILE Good_Enough Do BEGIN IF Main.Pos=1 THEN BEGIN IF Ent_Count<>1 THEN Error('Beginning Of Buffer Reached'); Ent_Begin:=Main.Pos+1; Good_Enough:=FALSE; END ELSE BEGIN C:=Buf_B_Get(Main); IF C IN ['.',';','!'] THEN BEGIN IF C<>' ' THEN BEGIN IF Sen_End THEN BEGIN Ent_Begin:=Main.Pos+1; Good_Enough:=FALSE; END ELSE BEGIN Sen_End:=TRUE; Sen_Delim:=TRUE; END; END ELSE IF Sen_End THEN BEGIN Ent_Begin:=Main.Pos+1; Good_Enough:=FALSE; END; END ELSE IF Sen_Delim THEN BEGIN Ent_Begin:=Main.Pos+1; Good_enough:=FALSE; END ELSE Sen_End:=TRUE; END; END; Ent_Count:=Ent_Count-1; END; Ent_Pos:=Ent_Begin; END; 1: END; [GLOBAL] PROCEDURE Line_End; {Finds the end of a line} VAR Good_Enough: BOOLEAN; Cr_Pos: INTEGER; LABEL 1; BEGIN Good_Enough:=TRUE; CASE Direction OF Minus: BEGIN IF Ent_Count=1 THEN BEGIN IF This_Pos=1 THEN Error('Beginning Of Buffer Reached') ELSE Ent_Begin:=This_Pos-1; END ELSE IF (Before_Got>=Ent_Count-1) THEN Ent_Begin:=Before_Pos[Ent_Count-1]-1 ELSE BEGIN WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Cr_Pos:=Buf_B_Find(Main,''(128)''); IF Cr_Pos=0 THEN BEGIN Error('Beginning Of Buffer Reached'); Good_Enough:=FALSE; END ELSE BEGIN Ent_Count:=Ent_Count-1; Ent_Begin:=Main.Pos; IF Ent_Count=0 THEN Good_Enough:=FALSE; END; END; END; Ent_Pos:=Ent_Begin; END; Plus: BEGIN IF (After_Got>Ent_Count) AND (My_Pos=After_Pos[1]-1) THEN Ent_End:=After_Pos[Ent_Count+1]-1 ELSE IF (After_Got>=Ent_Count) AND (My_Pos<>After_Pos[1]-1) THEN Ent_End:=After_Pos[Ent_Count]-1 ELSE BEGIN IF After_Got>0 THEN BEGIN Buf_Goto(Main,After_Pos[After_Got]); Ent_Count:=Ent_Count-After_Got; END ELSE Buf_Goto(Main,My_Pos); WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Cr_Pos:=Buf_Find(Main,''(128)''); IF Cr_Pos=0 THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; END ELSE BEGIN IF After_Got=Ent_Count-1 THEN Ent_Begin:=Before_Pos[Ent_Count-1] ELSE IF This_Line<=Ent_Count THEN BEGIN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; END ELSE BEGIN IF Before_Got>0 THEN BEGIN Buf_Goto(Main,Before_Pos[Before_Got]); Ent_Count:=Ent_Count-Before_Got; END ELSE Buf_Goto(Main,My_Pos); WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; IF Main.Pos=1 THEN BEGIN Error('Beginning Of Buffer Reached'); Good_Enough:=FALSE; Ent_Begin:=1; END ELSE BEGIN Cr_Pos:=Buf_B_Find(Main,''(128)''); IF CR_Pos=0 THEN BEGIN Error('Beginning Of Buffer Reached'); Good_Enough:=FALSE; Ent_Begin:=1; END ELSE BEGIN Ent_Count:=Ent_Count-1; Ent_Begin:=Cr_Pos; IF Ent_Count=0 THEN Good_Enough:=FALSE; END; END; END; END; Ent_Pos:=Ent_Begin; 1: END; [GLOBAL] PROCEDURE Line_Next; {Finds the next line} VAR Good_Enough: BOOLEAN; Cr_Pos: INTEGER; LABEL 1; BEGIN IF Ent_Count<=After_Got THEN Ent_End:=After_Pos[Ent_Count] ELSE BEGIN IF After_Got>0 THEN BEGIN Buf_Goto(Main,After_Pos[After_Got]); Ent_Count:=Ent_Count-After_Got; END ELSE Buf_Goto(Main,My_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; IF Main.Pos>Main.Bufsize THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; Ent_End:=Main.Bufsize+1; END ELSE BEGIN Cr_Pos:=Buf_Find(Main,''(128)''); IF Cr_Pos=0 THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; Ent_End:=Main.Bufsize+1; END ELSE BEGIN IF After_GotC_NULL) OR (L_Entity<>E_V) THEN BEGIN V_Col:=My_Col; F_Col:=V_Col; END ELSE F_Col:=V_Col; CASE Direction OF Plus: BEGIN IF Ent_Count<=After_Got THEN Ent_End:=After_Pos[Ent_Count] ELSE BEGIN IF After_Got>0 THEN BEGIN Buf_Goto(Main,After_Pos[After_Got]); Ent_Count:=Ent_Count-After_Got; END ELSE Buf_Goto(Main,My_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; IF Main.Pos>Main.Bufsize THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; Ent_End:=Main.Bufsize+1; END ELSE BEGIN Cr_Pos:=Buf_Find(Main,''(128)''); IF Cr_Pos=0 THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; Ent_End:=Main.Bufsize+1; END ELSE BEGIN IF After_Got=Ent_Count-1 THEN Ent_Begin:=Before_Pos[Ent_Count-1] ELSE IF This_Line<=Ent_Count THEN BEGIN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; END ELSE BEGIN IF Before_Got>0 THEN BEGIN Buf_Goto(Main,Before_Pos[Before_Got]); Ent_Count:=Ent_Count-Before_Got; END ELSE Buf_Goto(Main,My_Pos); WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; IF Main.Pos=1 THEN BEGIN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; END ELSE BEGIN Cr_Pos:=Buf_B_Find(Main,''(128)''); IF CR_Pos=0 THEN BEGIN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; END ELSE BEGIN Ent_Count:=Ent_Count-1; Ent_Begin:=Cr_Pos; IF Ent_Count=0 THEN Good_Enough:=FALSE; END; END; END; END; Ent_Pos:=Ent_Begin; END; END; Save_Col:=My_Col; My_Col:=1; Buf_Goto(Main,Ent_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Main.Pos>Main.Bufsize THEN Good_Enough:=FALSE ELSE BEGIN C:=Buf_Get(Main); IF C=''(128)'' THEN Good_Enough:=FALSE ELSE IF My_Col>=F_Col THEN Good_Enough:=FALSE ELSE IF C IN Printable THEN BEGIN My_Col:=My_Col+1; Ent_Pos:=Ent_Pos+1; END ELSE BEGIN Char_Rep(ORD(C),S,Plus); My_Col:=My_Col+LENGTH(S); Ent_Pos:=Ent_Pos+1; END; END; END; IF Direction=Plus THEN Ent_End:=Ent_Pos ELSE Ent_Begin:=Ent_Pos; My_Col:=Save_Col; 1: END; [GLOBAL] PROCEDURE Find_Next(Start_Pos: INTEGER); {Finds the string in the search buffer} VAR I_Char, M_Char: CHAR; S_C_Pos, S_M_Pos: INTEGER; Good_Enough, Also_Good_Enough: BOOLEAN; LABEL 1; BEGIN IF B_Search=0 THEN Error('No Search String') ELSE IF L_Search<>0 THEN BEGIN S_C_Pos:=B_Search; Buf_Goto(Pad,B_Search); I_Char:=Buf_Get(Pad); IF I_Char IN Alpha_L THEN I_Char:=CHR(ORD(I_Char)-32); Good_Enough:=TRUE; CASE Direction OF Plus: BEGIN S_M_Pos:=Start_Pos-1; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Buf_Goto(Main,S_M_Pos+1); IF Pad.Pos<>S_C_Pos+1 THEN BEGIN Buf_Goto(Pad,S_C_Pos); I_Char:=Buf_Get(Pad); IF I_Char IN Alpha_L THEN I_Char:=CHR(ORD(I_Char)-32); END; S_M_Pos:=Buf_Find(Main,I_Char)-1; IF S_M_Pos=-1 THEN BEGIN Error('End Of Buffer Reached'); Good_Enough:=FALSE; END ELSE BEGIN Also_Good_Enough:=TRUE; WHILE Also_Good_Enough DO BEGIN IF Pad.Pos-S_C_Pos=L_Search THEN BEGIN IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Also_Good_Enough:=FALSE; Ent_Begin:=S_M_Pos; Ent_Pos:=Ent_Begin; Ent_End:=Main.Pos; END ELSE BEGIN I_Char:=Buf_Get(Pad); IF I_Char IN Alpha_L THEN I_Char:=CHR(ORD(I_Char)-32); IF Main.Pos>Main.Bufsize THEN BEGIN Good_Enough:=FALSE; Also_Good_Enough:=FALSE; Error('End Of Buffer Reached'); END ELSE BEGIN M_Char:=Buf_Get(Main); IF M_Char IN Alpha_L THEN M_Char:=CHR(ORD(M_Char)-32) ELSE IF M_Char=''(128)'' THEN M_Char:=''(13)''; IF M_Char<>I_Char THEN Also_Good_Enough:=FALSE; END; END; END; END; END; END; Minus: BEGIN S_M_Pos:=Start_Pos+1; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Buf_Goto(Main,S_M_Pos); IF Pad.Pos<>S_C_Pos+1 THEN BEGIN Buf_Goto(Pad,S_C_Pos); I_Char:=Buf_Get(Pad); IF I_Char IN Alpha_L THEN I_Char:=CHR(ORD(I_Char)-32); END; S_M_Pos:=Buf_B_Find(Main,I_Char); IF S_M_Pos=0 THEN BEGIN Error('Beginning Of Buffer Reached'); Good_Enough:=FALSE; END ELSE BEGIN Buf_Goto(Main,Main.Pos+1); Also_Good_Enough:=TRUE; WHILE Also_Good_Enough DO BEGIN IF Pad.Pos-S_C_Pos=L_Search THEN BEGIN IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Also_Good_Enough:=FALSE; Ent_Begin:=S_M_Pos; Ent_Pos:=Ent_Begin; Ent_End:=Main.Pos; END ELSE BEGIN I_Char:=Buf_Get(Pad); IF I_Char IN Alpha_L THEN I_Char:=CHR(ORD(I_Char)-32); IF Main.Pos>Main.Bufsize THEN BEGIN Good_Enough:=FALSE; Also_Good_Enough:=FALSE; Error('End Of Buffer Reached'); END ELSE BEGIN M_Char:=Buf_Get(Main); IF M_Char IN Alpha_L THEN M_Char:=CHR(ORD(M_Char)-32) ELSE IF M_Char=''(128)'' THEN M_Char:=''(13)''; IF M_Char<>I_Char THEN Also_Good_Enough:=FALSE; END; END; END; END; END; END; END; END; 1: END; [GLOBAL] PROCEDURE Find_String; {Gets a string from the command buffer and find it} VAR I_Char, S_Delim: CHAR; S_C_Pos: INTEGER; Good_Enough: BOOLEAN; BEGIN IF Com.Pos>=Com.Bufsize THEN Error('No Search String Entered') ELSE BEGIN S_Delim:=Buf_Get(Com); S_C_Pos:=Com.Pos; IF Buf_Get(Com)<>S_Delim THEN BEGIN IF B_Search<>0 THEN BEGIN Buf_Goto(Pad,B_Search); Buf_Remove(Pad,L_Search); Pad_Adj(B_Search,-L_Search); END; B_Search:=Pad.Bufsize+1; Buf_Goto(Pad,B_Search); L_Search:=0; END; Buf_Goto(Com,S_C_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN I_Char:=Buf_Get(Com); IF I_Char=S_Delim THEN Good_Enough:=FALSE ELSE BEGIN Buf_Put(Pad,I_Char); L_Search:=L_Search+1; IF Com.Pos=Com.Bufsize+1 THEN Good_Enough:=FALSE; END; END; IF Direction=Plus THEN Find_Next(My_Pos+1) ELSE Find_Next(My_Pos-1); END; END; [GLOBAL] PROCEDURE Substitute_Next; {Does the substitution given in the search and substitute buffers} BEGIN Find_Next(My_Pos); IF NOT Error_Flag THEN BEGIN Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,Ent_Begin); Move_Into(B_Delete,L_Delete); IF B_Subs<>0 THEN BEGIN Buf_Goto(Main,My_Pos); Move_From(Pad,B_Subs,L_Subs); END; END; END; [GLOBAL] PROCEDURE Substitute; {Gets a search and substitute string and does the substitution} VAR I_Char, S_Delim: CHAR; S_C_Pos: INTEGER; Good_Enough: BOOLEAN; BEGIN IF Com.Pos>=Com.Bufsize THEN Error('No Search String Entered') ELSE BEGIN S_Delim:=Buf_Get(Com); S_C_Pos:=Com.Pos; IF Buf_Get(Com)<>S_Delim THEN BEGIN IF B_Search<>0 THEN BEGIN Buf_Goto(Pad,B_Search); Buf_Remove(Pad,L_Search); Pad_Adj(B_Search,-L_Search); END; B_Search:=Pad.Bufsize+1; Buf_Goto(Pad,B_Search); L_Search:=0; END; Buf_Goto(Com,S_C_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN I_Char:=Buf_Get(Com); IF I_Char=S_Delim THEN Good_Enough:=FALSE ELSE BEGIN Buf_Put(Pad,I_Char); L_Search:=L_Search+1; IF Com.Pos=Com.Bufsize+1 THEN Good_Enough:=FALSE; END; END; S_C_Pos:=Com.Pos; IF Buf_Get(Com)<>S_Delim THEN BEGIN IF B_Subs<>0 THEN BEGIN Buf_Goto(Pad,B_Subs); Buf_Remove(Pad,L_Subs); Pad_Adj(B_Subs,-L_Subs); END; B_Subs:=Pad.Bufsize+1; Buf_Goto(Pad,B_Subs); L_Subs:=0; END; Buf_Goto(Com,S_C_Pos); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN I_Char:=Buf_Get(Com); IF I_Char=S_Delim THEN Good_Enough:=FALSE ELSE BEGIN Buf_Put(Pad,I_Char); L_Subs:=L_Subs+1; IF Com.Pos=Com.Bufsize+1 THEN Good_Enough:=FALSE; END; END; WHILE (Rep_Count>0) AND NOT Error_Flag DO BEGIN Substitute_Next; Rep_Count:=Rep_Count-1; END; END; END; [GLOBAL] PROCEDURE Par_End; {Finds the end of a paragraph} VAR Save_Pos: INTEGER; Good_Enough: BOOLEAN; I_Char: CHAR; LABEL 1; BEGIN IF Main.Pos>Main.Bufsize THEN BEGIN Error('End Of Buffer Reached'); GOTO 1; END; IF Main.Pos<=Main.Bufsize THEN Buf_Goto(Main,Main.Pos+1); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Save_Pos:=Buf_Find(Main,''(128)''); IF Save_Pos=0 THEN BEGIN Good_Enough:=FALSE; IF Ent_Count<>1 THEN Error('End Of Buffer Reached'); Ent_End:=Main.Bufsize+1; Ent_Pos:=Ent_End; END ELSE BEGIN IF Main.Pos>Main.Bufsize THEN BEGIN Good_Enough:=FALSE; IF Ent_Count<>1 THEN Error('End Of Buffer Reached'); Ent_End:=Main.Bufsize+1; Ent_Pos:=Ent_End; END ELSE BEGIN I_Char:=Buf_Get(Main); IF I_Char=''(128)'' THEN BEGIN WHILE (I_Char=''(128)'') AND (Main.Pos<=Main.Bufsize) DO I_Char:=Buf_Get(Main); IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Ent_End:=Main.Pos-1; Ent_Pos:=Ent_End; END; END; END; END; 1: END; [GLOBAL] PROCEDURE Par_Begin; {Finds the beginning of a paragraph} VAR Save_Pos: INTEGER; Good_Enough: BOOLEAN; I_Char: CHAR; LABEL 1; BEGIN Good_Enough:=TRUE; IF Main.Pos=1 THEN BEGIN Error('Beginning Of Buffer Reached'); GOTO 1; END; I_Char:=Buf_B_Get(Main); WHILE (I_Char=''(128)'') AND (Main.Pos<>1) DO I_Char:=Buf_B_Get(Main); WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Save_Pos:=Buf_B_Find(Main,''(128)''); IF Save_Pos=0 THEN BEGIN Good_Enough:=FALSE; IF Ent_Count<>1 THEN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; Ent_Pos:=Ent_Begin; END ELSE BEGIN IF Main.Pos=1 THEN BEGIN Good_Enough:=FALSE; IF Ent_Count<>1 THEN Error('Beginning Of Buffer Reached'); Ent_Begin:=1; Ent_Pos:=Ent_Begin; END ELSE BEGIN I_Char:=Buf_B_Get(Main); IF I_Char=''(128)'' THEN BEGIN IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Ent_Begin:=Main.Pos+2; Ent_Pos:=Ent_Begin; END; END; END; END; 1: END; [GLOBAL] PROCEDURE Page_End; {Finds the end of a page} VAR Save_Pos: INTEGER; Good_Enough: BOOLEAN; LABEL 1; BEGIN IF Main.Pos<=Main.Bufsize THEN Buf_Goto(Main,Main.Pos+1); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Save_Pos:=Buf_Find(Main,''(12)''); IF Save_Pos=0 THEN BEGIN Good_Enough:=FALSE; Error('End Of Buffer Reached'); Ent_End:=Main.Bufsize+1; Ent_Pos:=Ent_End; END ELSE BEGIN IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Ent_End:=Main.Pos; Ent_Pos:=Ent_End; END; END; 1: END; [GLOBAL] PROCEDURE Page_Begin; {Finds the beginning of a page} VAR Save_Pos: INTEGER; Good_Enough: BOOLEAN; LABEL 1; BEGIN Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Ctrlc_Flag THEN GOTO 1; Save_Pos:=Buf_B_Find(Main,''(12)''); IF Save_Pos=0 THEN BEGIN Good_Enough:=FALSE; Error('Beginning Of Buffer Reached'); Ent_Begin:=1; Ent_Pos:=Ent_Begin; END ELSE BEGIN IF Ent_Count=1 THEN Good_Enough:=FALSE ELSE Ent_Count:=Ent_Count-1; Ent_Begin:=Main.Pos; Ent_Pos:=Ent_Begin; END; END; 1: END; [GLOBAL] PROCEDURE Ex_Entity; {Finds the given entity} BEGIN Ent_Begin:=My_Pos; Ent_End:=My_Pos; Ent_Pos:=My_Pos; CASE Entity OF E_BL: Line_Begin; E_BPAGE: Page_Begin; E_BPAR: Par_Begin; E_BR: BEGIN Ent_Begin:=1; Ent_Pos:=Ent_Begin; Direction:=Minus; END; E_BSEN: Sen_Begin; E_BW: Word_Begin; E_C: BEGIN CASE Direction OF Plus: BEGIN IF My_Pos+Ent_Count>Main.Bufsize+1 THEN Error('End Of Buffer Reached') ELSE BEGIN Ent_End:=My_Pos+Ent_Count; Ent_Pos:=Ent_End; END; END; Minus: BEGIN IF My_Pos-Ent_Count<1 THEN Error('Beginning Of Buffer Reached') ELSE BEGIN Ent_Begin:=My_Pos-Ent_Count; Ent_Pos:=Ent_Begin; END; END; END; END; E_EL: Line_End; E_EPAGE: Page_End; E_EPAR: Par_End; E_ER: BEGIN Ent_End:=Main.Bufsize+1; Ent_Pos:=Ent_End; Direction:=Plus; END; E_ESEN: Sen_End; E_EW: Word_End; E_GOTO: IF Ent_Count IN [1..Maxmarks] THEN BEGIN IF Marks[Ent_Count]<>0 THEN BEGIN Ent_Pos:=Marks[Ent_Count]; IF Ent_Pos0 THEN BEGIN IF My_PosSel_Pos THEN Ent_Begin:=Sel_Pos; END ELSE Error('Select Not Active'); E_V: Vertical; E_W: BEGIN CASE Direction OF Plus: Word_End; Minus: Word_Begin; END; END; END; L_Entity:=Entity; END; [GLOBAL] FUNCTION Get_Entity(S: String): BOOLEAN; {Searches for S in the valid entity names} VAR L: INTEGER; BEGIN Entity:=E_ILL; L:=LENGTH(S); CASE L OF 1: BEGIN IF S='L' THEN Entity:=E_L ELSE IF S='V' THEN Entity:=E_V ELSE IF S='W' THEN Entity:=E_W; END; 2: BEGIN IF S='BL' THEN Entity:=E_BL ELSE IF S='BR' THEN Entity:=E_BR ELSE IF S='BW' THEN Entity:=E_BW ELSE IF S='CH' THEN Entity:=E_C ELSE IF S='EL' THEN Entity:=E_EL ELSE IF S='ER' THEN Entity:=E_ER ELSE IF S='EW' THEN Entity:=E_EW ELSE IF S='NL' THEN Entity:=E_NL ELSE IF S='NS' THEN Entity:=E_NS ELSE IF S='SR' THEN Entity:=E_SR; END; 3: BEGIN IF S='PAR' THEN Entity:=E_PAR ELSE IF S='SEN' THEN Entity:=E_SEN; END; 4: BEGIN IF S='BPAR' THEN Entity:=E_BPAR ELSE IF S='BSEN' THEN Entity:=E_BSEN ELSE IF S='EPAR' THEN Entity:=E_EPAR ELSE IF S='ESEN' THEN Entity:=E_ESEN ELSE IF S='PAGE' THEN Entity:=E_PAGE ELSE IF S='GOTO' THEN Entity:=E_GOTO; END; 5: BEGIN IF S='BPAGE' THEN Entity:=E_BPAGE ELSE IF S='EPAGE' THEN Entity:=E_EPAGE; END; END; Get_Entity:=Entity<>E_ILL; END; [GLOBAL] FUNCTION Read_Entity(P:INTEGER): BOOLEAN; {Gets the entity that should follow some commands} LABEL 1; VAR Com_Char: CHAR; Com_String: STRING; PROCEDURE Get_A_Char; {Gets a character from the command buffer} BEGIN IF Com.Pos>Com.Bufsize THEN GOTO 1; Com_Char:=Com_Ch_Get; IF Com_Char IN Alpha_L THEN Com_Char:=CHR(ORD(Com_Char)-32); END; BEGIN Ent_Count:=1; Buf_Goto(Main,My_Pos); Buf_Goto(Com,P); Read_Entity:=FALSE; Get_A_Char; IF Com_Char='+' THEN BEGIN Direction:=Plus; Get_A_Char; END ELSE IF Com_Char='-' THEN BEGIN Direction:=Minus; Get_A_Char; END; IF Com_Char IN Digits THEN BEGIN Ent_Count:=ORD(Com_Char)-ORD('0'); Get_A_Char; WHILE Com_Char IN Digits DO BEGIN Ent_Count:=Ent_Count*10+ORD(Com_Char)-ORD('0'); Get_A_Char; END; END; IF Com_Char='"' THEN BEGIN Entity:=E_QUOTE; Ex_Entity; Read_Entity:=NOT Error_Flag; END ELSE BEGIN IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; REPEAT IF Get_Entity(Com_String) THEN BEGIN Ex_Entity; Read_Entity:=NOT Error_Flag; GOTO 1; END; Get_A_Char; Com_String:=Com_String+' '; Com_String[LENGTH(Com_String)]:=Com_Char; UNTIL NOT (Com_Char IN Alpha_U); END; END; 1: END; [GLOBAL] PROCEDURE Define_Key; {Defines a key} LABEL 1; VAR C, Delim: CHAR; Index: INTEGER; PROCEDURE Get_A_Char; {Gets a character from the command buffer} BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('Key Definition Incomplete'); GOTO 1; END; C:=Buf_Get(Com); END; PROCEDURE Def_Put_Pad(VAR P_Start, P_Length: INTEGER); {Inserts the definition into the keypad database} VAR L: INTEGER; Good_Enough: BOOLEAN; BEGIN IF P_Length<>0 THEN BEGIN Buf_Goto(Pad,P_Start); Buf_Remove(Pad,P_Length); Pad_Adj(P_Start,-P_Length); END; L:=0; Buf_Goto(Pad,Pad.Bufsize+1); P_Start:=Pad.Pos; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN Get_A_Char; IF C<>Delim THEN BEGIN Buf_Put(Pad,C); L:=L+1; END ELSE BEGIN Good_Enough:=FALSE; IF L=0 THEN P_Start:=0; END; IF Com.Pos>Com.Bufsize THEN Good_Enough:=FALSE; END; P_Length:=L; END; PROCEDURE Get_Index; {Gets the key index from the command buffer} BEGIN REPEAT Get_A_Char; IF C IN Digits THEN Index:=Index*10+(ORD(C)-48); UNTIL NOT (C IN Digits); Delim:=C; END; PROCEDURE Key_Error; {Does an error and exits} BEGIN Error('Illegal Key Definition'); GOTO 1; END; BEGIN Index:=0; Get_A_Char; IF C='G' THEN BEGIN Get_A_Char; IF C='P' THEN BEGIN Get_Index; IF Index>45 THEN Key_Error; Def_Put_Pad(G_Pad_Start[Index],G_Pad_Length[Index]); END ELSE IF C='C' THEN BEGIN Get_Index; IF NOT (Index IN [0..31,127..159]) THEN Key_Error; Def_Put_Pad(G_Cont_Start[Index],G_Cont_Length[Index]); END ELSE IF C='K' THEN BEGIN Get_Index; IF (Index<33) OR (Index>126) THEN Key_Error; Def_Put_Pad(G_Char_Start[Index],G_Char_Length[Index]); END ELSE Key_Error; END ELSE IF C='P' THEN BEGIN Get_Index; IF Index>45 THEN Key_Error; Def_Put_Pad(Pad_Start[Index],Pad_Length[Index]); END ELSE IF C='C' THEN BEGIN Get_Index; IF NOT (Index IN [0..31,127..159]) THEN Key_Error; Def_Put_Pad(Cont_Start[Index],Cont_Length[Index]); END ELSE Key_Error; 1: END; [GLOBAL] PROCEDURE Refresh_Screen; VAR Temp_Line, Temp_Col: INTEGER; My_C: CHAR; BEGIN His_Line:=Maxlines+1; FOR Temp_Line:=1 TO Maxlines DO BEGIN Changes[Temp_Line]:=0; FOR Temp_Col:=1 TO Maxcol DO BEGIN My_C:=My_Screen[Temp_Line,Temp_Col]; His_Screen[Temp_Line,Temp_Col]:=' '; IF My_C<>' ' THEN BEGIN Any_Changes:=TRUE; Changes[Temp_Line]:=Changes[Temp_Line]+1; END; END; END; Clear_Screen; CASE Term_Type OF VT100,VT102: BEGIN Scroll_Top:=0; Set_Scroll(1,Maxlines); Escape('='); Escape('[?7l'); END; VT200: BEGIN Scroll_Top:=0; Set_Scroll(1,Maxlines); Escape('='); Put_String(''(155)'?7l'); END; VK100: BEGIN Escape('='); Escape('[?7l'); END; VT52: BEGIN Escape('='); END; END; END; [GLOBAL] PROCEDURE Help; {Puts a help message on the screen} VAR Save_Line, Save_Col, I: INTEGER; More: BOOLEAN; S: String; Help_File: FILE OF String; Help_Data: Long_String; LABEL 1; PROCEDURE Help_Put_String(S: STRING); {Puts a string on the screen} VAR I: INTEGER; RS: STRING; C: CHAR; BEGIN FOR I:=1 TO LENGTH(S) DO BEGIN C:=S[I]; IF C IN Printable THEN OPT_Put_Char(S[I]) ELSE BEGIN Char_Rep(ORD(C),RS,Plus); Help_Put_String(RS); END; END; END; PROCEDURE Help_Get_Pad(P_Start, P_Length: INTEGER); {Gets a keypad definition and puts it on the screen} VAR C: CHAR; S: String; BEGIN IF P_Start<>0 THEN BEGIN Buf_Goto(Pad,P_Start); FOR I:=1 TO P_Length DO BEGIN C:=Buf_Get(Pad); IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); Help_Put_String(S); END; END; END; END; FUNCTION Help_Wait: BOOLEAN; {Waits for the user to type a space or carriage return} VAR C: CHAR; T: Char_Type; I: INTEGER; BEGIN REPEAT T:=Get_Key(C,I);; IF C=' ' THEN Help_Wait:=FALSE ELSE IF C=''(13)'' THEN Help_Wait:=TRUE ELSE IF C=''(23)'' THEN Refresh_Screen ELSE Error('Type for More, to End'); UNTIL C IN [' ',''(13)'']; END; PROCEDURE Help_Next; {Goes to the next line. Waits if we are at the end of the screen} BEGIN My_Line:=My_Line+1; My_Col:=1; IF My_Line=Maxlines THEN BEGIN More:=Help_Wait; IF NOT More THEN GOTO 1; Any_Changes:=TRUE; OPT_Clr_Screen; My_Line:=Maxlines; My_Col:=1; Help_Put_String('Type for More, to End'); My_Line:=1; My_Col:=1; END; END; PROCEDURE Help_Line(S:String); {Puts a string on a line and advances} BEGIN Help_Put_String(S); Help_Next; END; BEGIN Save_Line:=My_Line; Save_Col:=My_Col; OPT_Clr_Screen; My_Line:=Maxlines; My_Col:=1; Help_Put_String('Type for More, to End'); My_Line:=1; My_Col:=1; More:=TRUE; CASE Term_Type OF VT52: S:='Sedt$Library:VT100HLP.SED'; VT100: S:='Sedt$Library:VT100HLP.SED'; VT102: S:='Sedt$Library:VT100HLP.SED'; VK100: S:='Sedt$Library:VT100HLP.SED'; VT200: S:='Sedt$Library:VT200HLP.SED'; END; OPEN(Help_File,S,READONLY,ERROR:=CONTINUE,RECORD_LENGTH:=80); RESET(Help_File,ERROR:=CONTINUE); IF Status(Help_File)<=0 THEN BEGIN WHILE NOT EOF(Help_File) DO BEGIN READ(Help_File,Help_Data); IF Help_Data[1]=''(12)'' THEN BEGIN IF My_Line<>1 THEN BEGIN My_Line:=23; Help_Next; END; END ELSE Help_Line(Help_Data); END; CLOSE(Help_File); END ELSE Error('No Help File:'+S); My_Line:=23; Help_Next; Help_Line('Commands:'); Help_Line(' Format: {+|-}{Count}Command'); Help_Line(' Count defaults to 1'); Help_Line(' {+|-}{Count}Entity: Move Count Entities'); Help_Line(' ADV Set Direction Forward'); Help_Line(' {Count}ASC Insert ASCII Character Count'); Help_Line(' BACK Set Direction Backward'); Help_Line(' {Count}CB Set Top of Cursor Window to Count'); Help_Line(' CEN Center Current Line'); Help_Line(' CGC{Count}Entity Change Case for This Character'); Help_Line(' {Count}CM Set Default Cursor Line to Count'); Help_Line(' {Count}CT Set Bottom of Cursor Window to Count'); Help_Line(' CUT Cut to Select Point'); Help_Line(' DEFKString'); Help_Line(' Define Key'); Help_Line(' DEL{+|-}{Count}Entity Delete Entity'); Help_Line(' DI Insert Todays Date and Time'); Help_Line(' EB Edit Buffer Number 1'); Help_Line(' {Count}EB Edit Buffer Number Count'); Help_Line(' EX Exit From SEDT'); Help_Line(' FIFilename'); Help_Line(' Include contents of file here'); Help_Line(' FWFilename'); Help_Line(' Write buffer into file'); Help_Line(' GET{+|-}{Count}Entity Move Entity to delete buffer'); Help_Line(' HELP Show This Text'); Help_Line(' I^Z: Insert String'); Help_Line(' KSFilename'); Help_Line(' Save key definitions in file'); Help_Line(' {Count}MARK Mark Current Position Mark No. Count'); Help_Line(' Marks are in the Range 1 to 10'); Help_Line(' {Count}ML Set indentation to count'); Help_Line(' {1/2}MODE Sets the editing mode'); Help_Line(' 1: Program: Words are only alphanumeric'); Help_Line(' 2: Text: Words are delimited by control'); Help_Line(' characters'); Help_Line(' {Count}MR Set right margin to count'); Help_Line(' PASTE Paste'); Help_Line(' QUIT Abort Session'); Help_Line(' REF Refresh Screen'); Help_Line(' RES Cancel GOLD, Count,'); Help_Line(' And Select Range'); Help_Line(' SEL Set Select Point'); Help_Line(' SN Substitute Next'); Help_Line(' STA Give Sedt Status'); Help_Line(' SUBString1String2'); Help_Line(' Substitute String1 by String2'); Help_Line(' TAB Indent if Left Margin,'); Help_Line(' Otherwise Insert TAB Character'); Help_Line(' TAKFilename'); Help_Line(' Take input from the given file'); Help_Line(' TC Set TAB Indentation to this column'); Help_Line(' {Count}TD Reduce Indentation by Count'); Help_Line(' TF{+|-}{Count} Fill text within entity'); Help_Line(' {Count}TI Increase Indentation by Count'); Help_Line(' TN Set VT100,VT102 Terminal in 80 Column Mode'); Help_Line(' {Count}TS Set tab stop at column Count'); Help_Line(' Clear all stops if Count equals 0'); Help_Line(' TW Set VT100,VT102 Terminal in 132 Column Mode'); Help_Line(' UNDC Undelete Character'); Help_Line(' UNDD Undelete Select Range'); Help_Line(' UNDL Undelete Line'); Help_Line(' UNDW Undelete Word'); Help_Line(' Z Zero the buffer'); Help_Line(' ^ Insert Control '); My_Line:=23; Help_Next; Help_Line('Entities:'); Help_Line(' BL Beginning of Line'); Help_Line(' BPAGE Beginning of Page'); Help_Line(' BPAR Beginning of Paragraph'); Help_Line(' BR To Beginning of Buffer'); Help_Line(' BSEN Beginning of Sentence'); Help_Line(' BW Beginning of Word'); Help_Line(' CH Character'); Help_Line(' EL End of Line'); Help_Line(' EPAGE End of Page'); Help_Line(' EPAR End of Paragraph'); Help_Line(' ER To End of Buffer'); Help_Line(' ESEN End of Sentence'); Help_Line(' EW End of Word'); Help_Line(' {Count}GOTO Mark Number Count'); Help_Line(' L Line'); Help_Line(' NL Next Line'); Help_Line(' NS Next Occurrence of String'); Help_Line(' PAGE Page'); Help_Line(' PAR Paragraph'); Help_Line(' SEN Sentence'); Help_Line(' SR Select Range'); Help_Line(' V Vertical'); Help_Line(' W Word'); Help_Line(' "String'); Help_Line(' Occurrence of string'); My_Line:=23; Help_Next; Help_Line('Tokens:'); Help_Line(' %L Absolute line number in the file'); Help_Line(' %C Character number within the line'); Help_Line(' %P Absolute character position in buffer'); Help_Line(' %M Negative of last move in characters'); Help_Line(' or size of last paste or undelete'); My_Line:=23; Help_Next; Help_Line('Function Keys:'); CASE Term_Type OF VT52,VT100,VT102,VK100,VT200: BEGIN FOR I:=0 TO 45 DO IF Pad_Start[I]<>0 THEN BEGIN Help_Put_String(' '); CASE I OF 0: Help_Put_String('0: '); 1: Help_Put_String('1: '); 2: Help_Put_String('2: '); 3: Help_Put_String('3: '); 4: Help_Put_String('4: '); 5: Help_Put_String('5: '); 6: Help_Put_String('6: '); 7: Help_Put_String('7: '); 8: Help_Put_String('8: '); 9: Help_Put_String('9: '); 10: Help_Put_String('PF1: '); 11: Help_Put_String('PF2: '); 12: Help_Put_String('Up Arrow: '); 13: Help_Put_String('Down Arrow: '); 14: Help_Put_String('Right Arrow: '); 15: Help_Put_String('Left Arrow: '); 16: Help_Put_String('.: '); 17: Help_Put_String('PF4: '); 18: Help_Put_String('-: '); 19: Help_Put_String(',: '); 20: Help_Put_String(' '); 21: Help_Put_String('Enter: '); 22: Help_Put_String('Find: '); 23: Help_Put_String('Insert Here: '); 24: Help_Put_String('Remove: '); 25: Help_Put_String('Select: '); 26: Help_Put_String('Prev Screen: '); 27: Help_Put_String('Next Screen: '); 28: Help_Put_String('F6: '); 29: Help_Put_String('F7: '); 30: Help_Put_String('F8: '); 31: Help_Put_String('F9: '); 32: Help_Put_String('F10: '); 34: Help_Put_String('F11(ESC): '); 35: Help_Put_String('F12(BS): '); 36: Help_Put_String('F13(LF): '); 37: Help_Put_String('F14: '); 39: Help_Put_String('Help: '); 40: Help_Put_String('Do: '); 42: Help_Put_String('F17: '); 43: Help_Put_String('F18: '); 44: Help_Put_String('F19: '); 45: Help_Put_String('F20: '); END; Help_Get_Pad(Pad_Start[I],Pad_Length[I]); Help_Next; END; END; END; My_Line:=23; Help_Next; Help_Line('Gold Function Keys:'); CASE Term_Type OF VT52,VT100,VT102,VK100,VT200: BEGIN FOR I:=0 TO 45 DO IF G_Pad_Start[I]<>0 THEN BEGIN Help_Put_String(' '); CASE I OF 0: Help_Put_String('Gold 0: '); 1: Help_Put_String('Gold 1: '); 2: Help_Put_String('Gold 2: '); 3: Help_Put_String('Gold 3: '); 4: Help_Put_String('Gold 4: '); 5: Help_Put_String('Gold 5: '); 6: Help_Put_String('Gold 6: '); 7: Help_Put_String('Gold 7: '); 8: Help_Put_String('Gold 8: '); 9: Help_Put_String('Gold 9: '); 10: Help_Put_String('Gold PF1: '); 11: Help_Put_String('Gold PF2: '); 12: Help_Put_String('Gold Up Arrow: '); 13: Help_Put_String('Gold Down Arrow:'); 14: Help_Put_String('Gold Right Arrow:'); 15: Help_Put_String('Gold Left Arrow:'); 16: Help_Put_String('Gold .: '); 17: Help_Put_String('Gold PF4: '); 18: Help_Put_String('Gold -: '); 19: Help_Put_String('Gold ,: '); 20: Help_Put_String('Gold '); 21: Help_Put_String('Gold Enter: '); 22: Help_Put_String('Gold Find: '); 23: Help_Put_String('Gold Insert Here:'); 24: Help_Put_String('Gold Remove: '); 25: Help_Put_String('Gold Select: '); 26: Help_Put_String('Gold Prev Screen:'); 27: Help_Put_String('Gold Next Screen:'); 28: Help_Put_String('Gold F6: '); 29: Help_Put_String('Gold F7: '); 30: Help_Put_String('Gold F8: '); 31: Help_Put_String('Gold F9: '); 32: Help_Put_String('Gold F10: '); 34: Help_Put_String('Gold F11(ESC): '); 35: Help_Put_String('Gold F12(BS): '); 36: Help_Put_String('Gold F13(LF): '); 37: Help_Put_String('Gold F14: '); 39: Help_Put_String('Gold Help: '); 40: Help_Put_String('Gold Do: '); 42: Help_Put_String('Gold F17: '); 43: Help_Put_String('Gold F18: '); 44: Help_Put_String('Gold F19: '); 45: Help_Put_String('Gold F20: '); END; Help_Get_Pad(G_Pad_Start[I],G_Pad_Length[I]); Help_Next; END; END; END; My_Line:=23; Help_Next; Help_Put_String('Control Characters:'); Help_Next; FOR I:=0 TO 159 DO IF Cont_Start[I]<>0 THEN BEGIN Help_Put_String(' '); IF I=0 THEN Help_Put_String('Control : ') ELSE IF I<32 THEN BEGIN Help_Put_String('Control '); OPT_Put_Char(CHR(I+64)); Help_Put_String(': '); END ELSE Help_Put_String(': '); Help_Get_Pad(Cont_Start[I],Cont_Length[I]); Help_Next; END; My_Line:=23; Help_Next; Help_Put_String('Gold Control Characters:'); Help_Next; FOR I:=0 TO 159 DO IF G_Cont_Start[I]<>0 THEN BEGIN Help_Put_String(' '); IF I=0 THEN Help_Put_String('Gold Control : ') ELSE IF I<32 THEN BEGIN Help_Put_String('Gold Control '); OPT_Put_Char(CHR(I+64)); Help_Put_String(': '); END ELSE Help_Put_String('Gold : '); Help_Get_Pad(G_Cont_Start[I],G_Cont_Length[I]); Help_Next; END; My_Line:=23; Help_Next; Help_Put_String('Gold Keys:'); Help_Next; FOR I:=33 TO 255 DO IF G_Char_Start[I]<>0 THEN BEGIN Help_Put_String(' Gold '); Char_Rep(I,S,Plus); S:=S+':'; Help_Put_String(S); Help_Put_String(''(9)''); Help_Get_Pad(G_Char_Start[I],G_Char_Length[I]); Help_Next; END; Help_Wait; 1: My_Line:=Save_Line; My_Col:=Save_Col; IF My_Line=1 THEN Fill_Screen(1,1,Maxlines+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); END; [GLOBAL] PROCEDURE Load_File; VAR Edit_File: FILE OF Long_String; I, J, Line_Length, Line_Index, In_Length: INTEGER; Edit_Line: Long_String; In_C: CHAR; BEGIN Buf_Reset(Main); This_Line:=1; This_Pos:=1; Before_Got:=0; After_Got:=0; My_Pos:=1; Sel_Pos:=0; My_Line:=1; My_Col:=1; I$Fill(Marks[1],Maxmarks,0); IF LENGTH(Input_Name)<>0 THEN BEGIN OPEN(Edit_File,Input_Name,READONLY,ERROR:=CONTINUE,RECORD_LENGTH:=255); RESET(Edit_File,ERROR:=CONTINUE); IF Status(Edit_File)<=0 THEN WITH Main DO BEGIN WHILE NOT EOF(Edit_File) DO BEGIN READ(Edit_File,Edit_Line); Line_Length:=LENGTH(Edit_Line); Line_Index:=1; IF Line_Length<>0 THEN BEGIN REPEAT IF Line_Length-Line_Index+1>Memmax-Memsize THEN BEGIN IF Memsize<>Memmax THEN BEGIN J:=Memmax-Memsize; IF Line_Index=1 THEN L$Move(Edit_Line.BODY,Membuf[Memptr],J) ELSE BEGIN FOR I:=0 TO J-1 DO Membuf[Memptr+I]:=Edit_Line[Line_Index+I]; END; Line_Index:=Line_Index+J; Memsize:=Memmax; Memptr:=Memmax+1; END; Out_Buf(Main); END ELSE BEGIN J:=Line_Length-Line_Index+1; IF Line_Index=1 THEN L$Move(Edit_Line.BODY,Membuf[Memptr],Line_Length) ELSE BEGIN FOR I:=0 TO J DO Membuf[Memptr+I]:=Edit_Line[Line_Index+I]; END; Memsize:=Memsize+J; Memptr:=Memptr+J; Line_Index:=Line_Length+1; END; UNTIL Line_Index>Line_Length; END; In_C:=''(128)''; IF Memsize=Memmax THEN BEGIN Out_Buf(Main); END; Membuf[Memptr]:=In_C; Memptr:=Memptr+1; Memsize:=Memsize+1; IF After_GotCom.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); New_Name:=''; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN In_C:=Buf_Get(Com); IF In_C=S_Delim THEN Good_Enough:=FALSE ELSE New_Name:=New_Name+In_C; END ELSE Good_Enough:=FALSE; END; IF LENGTH(New_Name)<>0 THEN Input_Name:=New_Name; Output_Name:=Input_Name; Load_File; IF Journal_Flag THEN BEGIN CLOSE(Journal_File,DELETE); In_Length:=LENGTH(Input_Name); I:=INDEX(Input_Name,']'); Journal_Name:=SUBSTR(Input_Name,I+1,In_Length-I); REPEAT J:=INDEX(Journal_Name,':'); IF J<>0 THEN Journal_Name:=SUBSTR(Journal_Name,J+1,LENGTH(Journal_Name)-J); UNTIL J=0; J:=INDEX(Journal_Name,'.'); IF J=0 THEN Journal_Name:=Journal_Name+'.JOU' ELSE Journal_Name:=SUBSTR(Journal_Name,1,J-1)+'.JOU'; OPEN(Journal_File,Journal_Name,NEW,ERROR:=CONTINUE); REWRITE(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Opening Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; 1: END; [GLOBAL] PROCEDURE New_Out_File; {Defines a new output file name} VAR Good_Enough: BOOLEAN; S_Delim, In_C: CHAR; LABEL 1; BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); Output_Name:=''; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN In_C:=Buf_Get(Com); IF In_C=S_Delim THEN Good_Enough:=FALSE ELSE Output_Name:=Output_Name+In_C; END ELSE Good_Enough:=FALSE; END; 1: END; [GLOBAL] PROCEDURE Include_File; {Includes the contents of a file in the buffer} VAR Inc_File: FILE OF Long_String; Save_Pos, L, I, Line_Length, Line_Index: INTEGER; File_Name, Edit_Line: Long_String; Good_Enough: BOOLEAN; S_Delim, C: CHAR; LABEL 1; BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); File_Name:=''; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C=S_Delim THEN Good_Enough:=FALSE ELSE File_Name:=File_Name+C; END ELSE Good_Enough:=FALSE; END; Buf_Goto(Pad,Pad.Bufsize+1); Save_Pos:=Pad.Pos; OPEN(Inc_File,File_Name,READONLY,ERROR:=CONTINUE,RECORD_LENGTH:=255); RESET(Inc_File,ERROR:=CONTINUE); IF STATUS(Inc_File)<=0 THEN BEGIN IF Main.Bufsize=0 THEN BEGIN WITH Main DO BEGIN WHILE NOT EOF(Inc_File) DO BEGIN READ(Inc_File,Edit_Line); Line_Length:=LENGTH(Edit_Line); Line_Index:=1; IF Line_Length<>0 THEN BEGIN REPEAT IF Line_Length-Line_Index+1>Memmax-Memsize THEN BEGIN IF Memsize<>Memmax THEN BEGIN IF Line_Index=1 THEN L$Move(Edit_Line.BODY,Membuf[Memptr],Memmax-Memsize) ELSE BEGIN FOR I:=0 TO Memmax-Memsize-1 DO Membuf[Memptr+I]:=Edit_Line[Line_Index+I]; END; Line_Index:=Line_Index+Memmax-Memsize; Memsize:=Memmax; Memptr:=Memmax+1; END; Out_Buf(Main); END ELSE BEGIN IF Line_Index=1 THEN L$Move(Edit_Line.BODY,Membuf[Memptr],Line_Length) ELSE BEGIN FOR I:=0 TO Line_Length-Line_Index DO Membuf[Memptr+I]:=Edit_Line[Line_Index+I]; END; Memsize:=Memsize+Line_Length-Line_Index+1; Memptr:=Memptr+Line_Length-Line_Index+1; Line_Index:=Line_Length+1; END; UNTIL Line_Index>Line_Length; END; C:=''(128)''; IF Memsize=Memmax THEN BEGIN Out_Buf(Main); END; Membuf[Memptr]:=C; Memptr:=Memptr+1; Memsize:=Memsize+1; IF After_Got0 DO BEGIN IF Memsize=Memmax THEN Out_Buf(Pad); L:=LENGTH(Edit_Line); IF L>Memmax-Memsize THEN L:=Memmax-Memsize; L$Move(Edit_Line.BODY,Membuf[Memptr],L); Bufsize:=Bufsize+L; Memsize:=Memsize+L; Memptr:=Memptr+L; Pos:=Pos+L; Edit_Line:=SUBSTR(Edit_Line,L,LENGTH(Edit_Line)-L); END; IF Memsize=Memmax THEN Out_Buf(Pad); Membuf[Memptr]:=''(128)''; Bufsize:=Bufsize+1; Memsize:=Memsize+1; Memptr:=Memptr+1; Pos:=Pos+1; END; Move_From(Pad,Save_Pos,Bufsize-Save_Pos+1); Buf_Goto(Pad,Save_Pos); Buf_Remove(Pad,Bufsize-Save_Pos+1); END; END; CLOSE(Inc_File); END ELSE Error('File Not Found'); 1: END; [GLOBAL] PROCEDURE Com_Parse(P: INTEGER);FORWARD; [GLOBAL] PROCEDURE Take_File; {Takes commands from an indirect file} VAR Inp_File: FILE OF Long_String; L: INTEGER; File_Name, Edit_Line: Long_String; S_Delim, C: CHAR; Good_Enough: BOOLEAN; LABEL 1; BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); Good_Enough:=TRUE; File_Name:=''; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C=S_Delim THEN Good_Enough:=FALSE ELSE File_Name:=File_Name+C; END ELSE Good_Enough:=FALSE; END; OPEN(Inp_File,File_Name,READONLY,ERROR:=CONTINUE,RECORD_LENGTH:=255); RESET(Inp_File,ERROR:=CONTINUE); IF STATUS(Inp_File)<=0 THEN WITH Com DO BEGIN WHILE (NOT EOF(Inp_File)) AND (NOT Error_Flag) DO BEGIN Buf_Reset(Com); READ(Inp_File,Edit_Line); WHILE LENGTH(Edit_Line)>0 DO BEGIN IF Memsize=Memmax THEN Out_Buf(Com); L:=LENGTH(Edit_Line); IF L>Memmax-Memsize THEN L:=Memmax-Memsize; L$Move(Edit_Line.BODY,Membuf[Memptr],L); Bufsize:=Bufsize+L; Memsize:=Memsize+L; Memptr:=Memptr+L; Pos:=Pos+L; Edit_Line:=SUBSTR(Edit_Line,L,LENGTH(Edit_Line)-L); END; IF Edit_Line[1]<>';' THEN Com_Parse(1); END; CLOSE(Inp_File); END ELSE Error('File Not Found'); 1: END; [GLOBAL] PROCEDURE Save_File(Output_Name: Long_String); {Saves the contents of the buffer in a file} VAR Edit_File: FILE OF Long_String; Save_Pos, Temp_Line, Line_Begin, Line_End, Interval, Line_Length: INTEGER; Edit_Line: Long_String; In_C: CHAR; Good_Enough: BOOLEAN; BEGIN OPEN(Edit_File,Output_Name,NEW,ERROR:=CONTINUE,RECORD_LENGTH:=255); IF STATUS(Edit_File)<=0 THEN BEGIN REWRITE(Edit_File,ERROR:=CONTINUE); Save_Pos:=My_Pos; Buf_Goto(Main,1); Temp_Line:=1; Edit_Line:=''; WITH Main DO BEGIN Good_Enough:=FALSE; IF Temp_Line0 THEN BEGIN Good_Enough:=TRUE; Line_Begin:=This_Pos; Line_End:=After_Pos[1]; END; IF Good_Enough THEN BEGIN Line_Length:=Line_End-Line_Begin-1; IF Pos<=Bufsize THEN BEGIN IF Memsize-Memptr+1Memsize THEN BEGIN IF Memmax-MemsizeThis_Line THEN BEGIN Interval:=Temp_Line-This_Line; IF After_Got>=Interval+1 THEN BEGIN Good_Enough:=TRUE; Line_Begin:=After_Pos[Interval]; Line_End:=After_Pos[Interval+1]; END; END ELSE IF After_Got>0 THEN BEGIN Good_Enough:=TRUE; Line_Begin:=This_Pos; Line_End:=After_Pos[1]; END; IF Good_Enough THEN BEGIN Line_Length:=Line_End-Line_Begin-1; IF Pos<=Bufsize THEN BEGIN IF Memsize-Memptr+10 THEN WRITE(Edit_File,Edit_Line,ERROR:=CONTINUE); IF STATUS(Edit_File)>0 THEN BEGIN Error('Error Writing File'); CLOSE(Edit_File,DELETE); END ELSE CLOSE(Edit_File,ERROR:=CONTINUE); Buf_Goto(Main,Save_Pos); END ELSE Error('Error Writing File'); END; [GLOBAL] PROCEDURE New_Journal; {Creates a new journal file} BEGIN IF Journal_Flag THEN BEGIN CLOSE(Journal_File,DELETE); OPEN(Journal_File,Journal_Name,NEW,ERROR:=CONTINUE); REWRITE(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Opening Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; END; [GLOBAL] PROCEDURE Write_File; {Writes the contents of the buffer in a user defined file} VAR S_Delim, C: CHAR; Save_Name: Long_String; Good_Enough: BOOLEAN; LABEL 1; BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); Good_Enough:=TRUE; Save_Name:=''; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C=S_Delim THEN Good_Enough:=FALSE ELSE Save_Name:=Save_Name+C; END ELSE Good_Enough:=FALSE; END; IF LENGTH(Save_Name)<>0 THEN BEGIN Save_File(Save_Name); New_Journal; END ELSE IF (LENGTH(Output_Name)<>0) AND (Current_Buffer=1) THEN BEGIN Save_File(Output_Name); New_Journal; END ELSE Error('No Output File'); 1: END; [GLOBAL] PROCEDURE Save_Keys; {Saves the current key definitions in a file} VAR Edit_File: TEXT; S_Delim, C: CHAR; Output_Name: Long_String; Good_Enough: BOOLEAN; I, J: INTEGER; LABEL 1; BEGIN IF Com.Pos>Com.Bufsize THEN BEGIN Error('No File Name Given'); GOTO 1; END; S_Delim:=Buf_Get(Com); Good_Enough:=TRUE; Output_Name:=''; WHILE Good_Enough DO BEGIN IF Com.Pos<=Com.Bufsize THEN BEGIN C:=Buf_Get(Com); IF C=S_Delim THEN Good_Enough:=FALSE ELSE Output_Name:=Output_Name+C; END ELSE Good_Enough:=FALSE; END; OPEN(Edit_File,Output_Name,NEW,ERROR:=CONTINUE,RECORD_LENGTH:=255); REWRITE(Edit_File,ERROR:=CONTINUE); IF STATUS(Edit_File)<=0 THEN BEGIN FOR I:=33 TO 255 DO IF G_Char_Start[I]<>0 THEN BEGIN WRITE(Edit_File,'DEFKGK',I:1,''(24)'',ERROR:=CONTINUE); Buf_Goto(Pad,G_Char_Start[I]); FOR J:=1 TO G_Char_Length[I] DO WRITE(Edit_File,Buf_Get(Pad),ERROR:=CONTINUE); WRITELN(Edit_File,''(24)'',ERROR:=CONTINUE); END; FOR I:=0 TO 45 DO IF Pad_Start[I]<>0 THEN BEGIN WRITE(Edit_File,'DEFKP',I:1,''(24)'',ERROR:=CONTINUE); Buf_Goto(Pad,Pad_Start[I]); FOR J:=1 TO Pad_Length[I] DO WRITE(Edit_File,Buf_Get(Pad),ERROR:=CONTINUE); WRITELN(Edit_File,''(24)'',ERROR:=CONTINUE); END; FOR I:=0 TO 45 DO IF G_Pad_Start[I]<>0 THEN BEGIN WRITE(Edit_File,'DEFKGP',I:1,''(24)'',ERROR:=CONTINUE); Buf_Goto(Pad,G_Pad_Start[I]); FOR J:=1 TO G_Pad_Length[I] DO WRITE(Edit_File,Buf_Get(Pad),ERROR:=CONTINUE); WRITELN(Edit_File,''(24)'',ERROR:=CONTINUE); END; FOR I:=0 TO 159 DO IF Cont_Start[I]<>0 THEN BEGIN WRITE(Edit_File,'DEFKC',I:1,''(24)'',ERROR:=CONTINUE); Buf_Goto(Pad,Cont_Start[I]); FOR J:=1 TO Cont_Length[I] DO WRITE(Edit_File,Buf_Get(Pad),ERROR:=CONTINUE); WRITELN(Edit_File,''(24)'',ERROR:=CONTINUE); END; FOR I:=0 TO 159 DO IF G_Cont_Start[I]<>0 THEN BEGIN WRITE(Edit_File,'DEFKGC',I:1,''(24)'',ERROR:=CONTINUE); Buf_Goto(Pad,G_Cont_Start[I]); FOR J:=1 TO G_Cont_Length[I] DO WRITE(Edit_File,Buf_Get(Pad),ERROR:=CONTINUE); WRITELN(Edit_File,''(24)'',ERROR:=CONTINUE); END; IF STATUS(Edit_File)>0 THEN BEGIN Error('File Write Error'); CLOSE(Edit_File,DELETE); END ELSE CLOSE(Edit_File); END; 1: END; [GLOBAL] PROCEDURE Fill_Region; {Does a text fill in the region selected} VAR Save_Pos, L, I: INTEGER; My_C, Last_C, Old_C: CHAR; Good_Enough, Paragraph: BOOLEAN; BEGIN IF Right_Margin=0 THEN Error('Right Margin Not Set') ELSE IF NOT Read_Entity(Com.Pos) THEN BEGIN IF NOT Error_Flag THEN Error('No Entity Given'); END ELSE BEGIN My_C:=''(128)''; Marks[Maxmarks+1]:=My_Pos; Marks[Maxmarks+2]:=Ent_End; Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,My_Pos); WHILE My_PosRight_Margin THEN BEGIN Save_Pos:=My_Pos; Old_C:=Buf_B_Get(Main); Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN {Look for the beginning of the word} IF Main.Pos=1 THEN Good_Enough:=FALSE ELSE BEGIN Old_C:=Buf_B_Get(Main); IF Old_C=''(128)'' THEN BEGIN Buf_Goto(Main,Save_Pos); Good_Enough:=FALSE; END ELSE IF Old_C IN Word_Delim THEN BEGIN L:=Save_Pos-Main.Pos-1; Move_Cursor(-L); Ins_Char(''(128)''); IF Left_Margin>0 THEN BEGIN FOR I:=1 TO Left_Margin DIV 8 DO Ins_Char(''(9)''); FOR I:=My_Col TO Left_Margin DO Ins_Char(' '); END; Move_Cursor(L); Good_Enough:=FALSE; END; END; END; Buf_Goto(Main,My_Pos); END; Last_C:=My_C; My_C:=Buf_Get(Main); Move_Cursor(1); IF My_C=''(128)'' THEN BEGIN {Look for multiple carriage returns} Paragraph:=FALSE; Ent_Begin:=Main.Pos-1; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Main.Pos>=Marks[Maxmarks+2] THEN BEGIN Ent_End:=Marks[Maxmarks+2]; Good_Enough:=FALSE; END ELSE BEGIN My_C:=Buf_Get(Main); IF My_C=''(128)'' THEN Paragraph:=TRUE ELSE IF NOT (My_C IN [' ',''(9)'']) THEN BEGIN Ent_End:=Main.Pos-1; IF NOT Paragraph THEN BEGIN Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,Ent_Begin); Move_Into(B_Delete,L_Delete); Buf_Goto(Main,My_Pos); IF Last_C<>' ' THEN Ins_Char(' '); END ELSE BEGIN Move_Cursor(Ent_End-My_Pos); Buf_Goto(Main,Ent_End); OPT_Update(1,Maxlines); Out_Zap; END; Good_Enough:=FALSE; END; END; END; END; END; Move_Cursor(Marks[Maxmarks+1]-My_Pos); END; END; [GLOBAL] PROCEDURE Change_Buffer(Buffer_Number:INTEGER); {Switches the edit window from one buffer to another} BEGIN Save_This_Line[Current_Buffer]:=This_Line; Save_This_Pos[Current_Buffer]:=This_Pos; Save_Before_Got[Current_Buffer]:=Before_Got; Save_After_Got[Current_Buffer]:=After_Got; Save_My_Pos[Current_Buffer]:=My_Pos; Save_Sel_Pos[Current_Buffer]:=Sel_Pos; Save_My_Line[Current_Buffer]:=My_Line; Save_My_Col[Current_Buffer]:=My_Col; Save_Main[Current_Buffer]:=Main; I$Move(Before_Pos[1],Save_Before_Pos[Current_Buffer,1],Before_Got); I$Move(After_Pos[1],Save_After_Pos[Current_Buffer,1],After_Got); Save_Marks[Current_Buffer]:=Marks; Save_My_Screen[Current_Buffer]:=My_Screen; Save_Used[Current_Buffer]:=TRUE; Current_Buffer:=Buffer_Number; Used:=Save_Used[Current_Buffer]; IF NOT Used THEN BEGIN This_Line:=1; This_Pos:=1; Before_Got:=0; After_Got:=0; My_Pos:=1; Sel_Pos:=0; My_Line:=1; My_Col:=1; I$Fill(Marks[1],Maxmarks,0); Buf_Init(Main); Main.I_File:=Current_Buffer; Main.O_File:=Current_Buffer; Fill_Screen(1,1,Maxcol+1,1,This_Pos); END ELSE BEGIN This_Line:=Save_This_Line[Current_Buffer]; This_Pos:=Save_This_Pos[Current_Buffer]; Before_Got:=Save_Before_Got[Current_Buffer]; After_Got:=Save_After_Got[Current_Buffer]; My_Pos:=Save_My_Pos[Current_Buffer]; Sel_Pos:=Save_Sel_Pos[Current_Buffer]; My_Line:=Save_My_Line[Current_Buffer]; My_Col:=Save_My_Col[Current_Buffer]; Main:=Save_Main[Current_Buffer]; I$Move(Save_Before_Pos[Current_Buffer,1],Before_Pos[1],Before_Got); I$Move(Save_After_Pos[Current_Buffer,1],After_Pos[1],After_Got); Marks:=Save_Marks[Current_Buffer]; My_Screen:=Save_My_Screen[Current_Buffer]; Change_Comp(1,Maxlines); END; END; [GLOBAL] PROCEDURE Center_Line; {Centers the current line} VAR My_C: CHAR; Good_Enough: BOOLEAN; Spaces: INTEGER; BEGIN Marks[Maxmarks+1]:=My_Pos; IF My_Pos<>This_Pos THEN Move_Cursor(This_Pos-My_Pos); Ent_Begin:=My_Pos; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN My_C:=Buf_Get(Main); IF My_C=''(128)'' THEN BEGIN Good_Enough:=FALSE; Error('Empty Line'); END ELSE IF NOT (My_C IN [' ',''(9)'']) THEN BEGIN Good_Enough:=FALSE; Ent_End:=Main.Pos-1; Move_Into(B_Delete,L_Delete); Spaces:=(Right_Margin-(After_Pos[1]-This_Pos-1)) DIV 2; WHILE Spaces>=8 DO BEGIN Ins_Char(''(9)''); Spaces:=Spaces-8; END; While Spaces<>0 DO BEGIN Ins_Char(' '); Spaces:=Spaces-1; END; IF Marks[Maxmarks+1]<>My_Pos THEN Move_Cursor(Marks[Maxmarks+1]-My_Pos); END; END; END; [GLOBAL] PROCEDURE Editor_Status; VAR Save_Line, Save_Col, I: INTEGER; More: BOOLEAN; S: String; C: CHAR; LABEL 1; PROCEDURE Status_Put_String(S: STRING); {Puts a string on the screen} VAR I: INTEGER; RS: STRING; C: CHAR; BEGIN FOR I:=1 TO LENGTH(S) DO BEGIN C:=S[I]; IF C IN Printable THEN OPT_Put_Char(S[I]) ELSE BEGIN Char_Rep(ORD(C),RS,Plus); Status_Put_String(RS); END; END; END; PROCEDURE Status_Get_Pad(P_Start, P_Length: INTEGER); {Gets a keypad definition and puts it on the screen} VAR C: CHAR; S: String; BEGIN IF P_Start<>0 THEN BEGIN Buf_Goto(Pad,P_Start); FOR I:=1 TO P_Length DO BEGIN C:=Buf_Get(Pad); IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); Status_Put_String(S); END; END; END; END; FUNCTION Status_Wait: BOOLEAN; {Waits for the user to type a space or carriage return} VAR C: CHAR; T: Char_Type; I: INTEGER; BEGIN REPEAT T:=Get_Key(C,I);; IF C=' ' THEN Status_Wait:=FALSE ELSE IF C=''(13)'' THEN Status_Wait:=TRUE ELSE IF C=''(23)'' THEN Refresh_Screen ELSE Error('Type for More, to End'); UNTIL C IN [' ',''(13)'']; END; PROCEDURE Status_Next; {Goes to the next line. Waits if we are at the end of the screen} BEGIN My_Line:=My_Line+1; My_Col:=1; IF My_Line=Maxlines THEN BEGIN More:=Status_Wait; IF NOT More THEN GOTO 1; Any_Changes:=TRUE; OPT_Clr_Screen; My_Line:=Maxlines; My_Col:=1; Status_Put_String('Type for More, to End'); My_Line:=1; My_Col:=1; END; END; PROCEDURE Status_Line(S:String); {Puts a string on a line and advances} BEGIN Status_Put_String(S); Status_Next; END; BEGIN Save_Line:=My_Line; Save_Col:=My_Col; OPT_Clr_Screen; My_Line:=Maxlines; My_Col:=1; Status_Put_String('Type for More, to End'); My_Line:=1; My_Col:=1; More:=TRUE; Status_Put_String('Sedt Status:'); My_Col:=30; Status_Line(Version); Status_Next; Status_Put_String('Input File: '); FOR I:=1 TO LENGTH(Input_Name) DO OPT_Put_Char(Input_Name[I]); Status_Next; Status_Put_String('Output File: '); FOR I:=1 TO LENGTH(Output_Name) DO OPT_Put_Char(Output_Name[I]); Status_Next; Status_Put_String('Command File: '); FOR I:=1 TO LENGTH(Com_Name) DO OPT_Put_Char(Com_Name[I]); Status_Next; Status_Put_String('Journal File: '); FOR I:=1 TO LENGTH(Journal_Name) DO OPT_Put_Char(Journal_Name[I]); Status_Next; Status_Next; IF L_Search<>0 THEN BEGIN Status_Put_String('Search String: '); Buf_Goto(Pad,B_Search); FOR I:=1 TO L_Search DO BEGIN C:=Buf_Get(Pad); IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); Status_Put_String(S); END; END; Status_Next; END ELSE Status_Line('Search String Empty'); IF L_Subs<>0 THEN BEGIN Status_Put_String('Substitute String: '); Buf_Goto(Pad,B_Subs); FOR I:=1 TO L_Subs DO BEGIN C:=Buf_Get(Pad); IF C IN Printable THEN OPT_Put_Char(C) ELSE BEGIN Char_Rep(ORD(C),S,Plus); Status_Put_String(S); END; END; Status_Next; END ELSE Status_Line('Substitute String Empty'); Status_Next; Status_Put_String('Line Number: '); WRITEV(S,This_Line:1); Status_Line(S); Status_Put_String('Character Position: '); WRITEV(S,My_Pos-This_Pos+1:1); Status_Line(S); Status_Next; Status_Put_String('Ruler: '); My_Col:=10; FOR I:=10 TO Screen_Width DO IF I<10 THEN OPT_Put_Char(' ') ELSE OPT_Put_Char(CHR(ORD('0')+(I DIV 10))); Status_Next; FOR I:=1 TO Screen_Width DO OPT_Put_Char(CHR(ORD('0')+(I MOD 10))); Status_Next; My_Col:=1; FOR I:=1 TO Tabs DO BEGIN My_Col:=Tab_Stops[I]; OPT_Put_Char('T'); END; My_Col:=9; WHILE My_Col<=Screen_Width DO BEGIN IF Tabs=0 THEN OPT_Put_Char('T') ELSE IF My_Col>Tab_Stops[Tabs] THEN OPT_Put_Char('T'); My_Col:=My_Col+8; END; IF Left_Margin<>0 THEN BEGIN My_Col:=Left_Margin; OPT_Put_Char('W'); END; IF Right_Margin<>0 THEN BEGIN My_Col:=Right_Margin; OPT_Put_Char('R'); END; My_Col:=1; OPT_Put_Char('L'); Status_Next; Status_Next; Status_Put_String('Buffer Size: '); WRITEV(S,Main.Bufsize:1); Status_Put_String(S); Status_Put_String(' Current Position: '); WRITEV(S,Main.Pos:1); Status_Line(S); IF Sel_Pos=0 THEN Status_Put_String('No Select Point') ELSE BEGIN Status_Put_String('Select Point: '); WRITEV(S,Sel_Pos:1); Status_Put_String(S); END; Status_Put_String(', Marks: '); FOR I:=1 TO Maxmarks DO BEGIN IF Marks[I]<>0 THEN BEGIN WRITEV(S,I:1); Status_Put_String(S); OPT_Put_Char('='); WRITEV(S,Marks[I]:1); Status_Put_String(S); OPT_Put_Char(' '); END; END; Status_Next; Status_Next; Status_Put_String('Current Buffer: '); WRITEV(S,Current_Buffer:1); Status_Put_String(S); Status_Put_String(' Buffers Used: '); FOR I:=1 TO Maxbuffers DO IF Save_Used[I] THEN BEGIN WRITEV(S,I:1); Status_Put_String(S); OPT_Put_Char(' '); END; My_Col:=1; My_Line:=Maxlines; Status_Wait; 1: My_Line:=Save_Line; My_Col:=Save_Col; IF My_Line=1 THEN Fill_Screen(1,1,Maxlines+1,1,This_Pos) ELSE Fill_Screen(1,1,Maxlines+1,1,Before_Pos[My_Line-1]); END; [GLOBAL] PROCEDURE Ex_Command; {Executes a command} VAR My_C: CHAR; Temp_Line, Temp_Col, I, Del_Chars, Del_Lines, Save_Pos, Copy_Chars: INTEGER; Good_Enough: BOOLEAN; S: PACKED ARRAY [1..11] OF CHAR; BEGIN Any_Changes:=TRUE; Direction:=Sign; CASE Command OF C_ADV: Def_Direction:=Plus; C_ASC: IF Rep_Count<=255 THEN BEGIN Ins_Char(CHR(Rep_Count)); END ELSE Error('Illegal Character Value'); C_BACK: Def_Direction:=Minus; C_CB: IF (Rep_Count>Maxlines) OR (Rep_Count<1) THEN Error('Line number out of range') ELSE IF Rep_CountCursor_Bottom) THEN Error('Line Number out of Range') ELSE Cursor_Middle:=Rep_Count; C_CT: IF (Rep_Count>Maxlines) OR (Rep_Count<1) THEN Error('Line number out of range') ELSE IF Rep_Count>Cursor_Bottom THEN Error('Top line cannot be greater than bottom line') ELSE BEGIN Cursor_Top:=Rep_Count; Cursor_Middle:=(Cursor_Top+Cursor_Bottom) DIV 2; END; C_CUT: BEGIN Entity:=E_SR; Ex_Entity; IF NOT Error_Flag THEN BEGIN Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,Ent_Begin); Move_Into(B_Paste,L_Paste); END; END; C_DEFK: Define_Key; C_DEL: BEGIN Save_Pos:=Com.Pos; WHILE (Rep_Count>0) AND (NOT Error_Flag) DO BEGIN Rep_Count:=Rep_Count-1; IF NOT Read_Entity(Save_Pos) THEN BEGIN IF NOT Error_Flag THEN Error('No Entity Given'); END ELSE BEGIN Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,Ent_Begin); IF Entity=E_C THEN Move_Into(B_Char,L_Char) ELSE IF Entity IN [E_W,E_BW,E_EW] THEN Move_Into(B_Word,L_Word) ELSE IF Entity IN [E_L,E_BL,E_EL,E_NL] THEN Move_Into(B_Line,L_Line) ELSE IF Entity=E_SR THEN Move_Into(B_Paste,L_Paste) ELSE Move_Into(B_Delete,L_Delete); END; END; END; C_DI: BEGIN DATE(S); FOR I:=1 TO 11 DO Ins_Char(S[I]); Ins_Char(' '); TIME(S); FOR I:=1 TO 11 DO Ins_Char(S[I]); END; C_EB: IF (Rep_Count>Maxbuffers) OR (Rep_Count<1) THEN Error('Illegal Buffer Number Given') ELSE Change_Buffer(Rep_Count); C_EX,C_QUIT: IF Current_Buffer<>1 THEN Change_Buffer(1); C_FE: BEGIN IF Current_Buffer<>1 THEN Change_Buffer(1); New_File; END; C_FI: Include_File; C_FO: New_Out_File; C_FW: Write_File; C_GET: BEGIN Save_Pos:=Com.Pos; WHILE (Rep_Count>0) AND (NOT Error_Flag) DO BEGIN Rep_Count:=Rep_Count-1; IF NOT Read_Entity(Save_Pos) THEN BEGIN IF NOT Error_Flag THEN Error('No Entity Given'); END ELSE BEGIN Ent_Pos:=My_Pos; Move_Cursor(Ent_Begin-My_Pos); Buf_Goto(Main,Ent_Begin); IF Entity=E_C THEN Get_Into(B_Char,L_Char) ELSE IF Entity IN [E_W,E_BW,E_EW] THEN Get_Into(B_Word,L_Word) ELSE IF Entity IN [E_L,E_BL,E_EL,E_NL] THEN Get_Into(B_Line,L_Line) ELSE IF Entity=E_SR THEN Get_Into(B_Paste,L_Paste) ELSE Get_Into(B_Delete,L_Delete); Move_Cursor(Ent_Pos-Ent_Begin); END; END; END; C_HELP: Help; C_I: BEGIN Save_Pos:=Com.Pos; Copy_Chars:=0; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF Com.Pos>Com.Bufsize THEN Good_Enough:=FALSE ELSE BEGIN My_C:=Buf_Get(Com); IF My_C=''(26)'' THEN Good_Enough:=FALSE ELSE Copy_Chars:=Copy_Chars+1; END; END; WHILE Rep_Count>0 DO BEGIN IF Copy_Chars=1 THEN BEGIN Buf_Goto(Com,Save_Pos); Ins_Char(Buf_Get(Com)); END ELSE BEGIN Move_From(Com,Save_Pos,Copy_Chars); IF Def_Direction=Minus THEN Move_Cursor(Copy_Chars); END; Rep_Count:=Rep_Count-1; END; IF Com.Pos<=Com.Bufsize THEN My_C:=Buf_Get(Com); END; C_KS: Save_Keys; C_MARK: IF Rep_Count IN [1..Maxmarks] THEN Marks[Rep_Count]:=My_Pos ELSE Error('Illegal Mark Number Entered'); C_ML: Left_Margin:=Rep_Count; C_MODE: IF Rep_Count IN [1,2] THEN BEGIN Mode:=Rep_Count; CASE Mode OF 1: Word_Delim:=[''(0)''..'/',':'..'@','['..'^','`','{'..''(128)'']; 2: Word_Delim:=[''(0)''..' ',''(127)''..''(159)'']; END; END ELSE Error('Illegal Mode'); C_MR: Right_Margin:=Rep_Count; C_REF: Refresh_Screen; C_RES: Sel_Pos:=0; C_SEL: Sel_Pos:=My_Pos; C_SN: WHILE (Rep_Count>0) AND NOT Error_Flag DO BEGIN Substitute_Next; Rep_Count:=Rep_Count-1; END; C_STA: Editor_Status; C_SUB: Substitute; C_TAB: WHILE Rep_Count>=1 DO BEGIN IF (My_Col=1) AND (Left_Margin>0) THEN BEGIN FOR I:=1 TO Left_Margin DIV 8 DO Ins_Char(''(9)''); FOR I:=My_Col TO Left_Margin DO Ins_Char(' '); END ELSE IF Tabs>0 THEN BEGIN Good_Enough:=TRUE; I:=1; WHILE Good_Enough DO BEGIN IF I>Tabs THEN BEGIN Ins_Char(''(9)''); Good_Enough:=FALSE; END ELSE IF Tab_Stops[I]>My_Col THEN BEGIN FOR I:=1 TO Tab_Stops[I]-My_Col DO Ins_Char(' '); Good_Enough:=FALSE; END ELSE I:=I+1; END; END ELSE Ins_Char(''(9)''); Rep_Count:=Rep_Count-1; END; C_TAK: Take_File; C_TC: Left_Margin:=My_Col-1; C_TD: FOR I:=1 TO Rep_Count DO IF Left_Margin>0 THEN Left_Margin:=Left_Margin-1; C_TF: Fill_Region; C_TI: Left_Margin:=Left_Margin+Rep_Count; C_TN: IF Term_Type IN [VT100,VT102,VT200] THEN BEGIN IF Term_Type=VT200 THEN Put_String(''(155)'?3l') ELSE Escape('[?3l'); Screen_Width:=80; FOR Temp_Line:=1 TO Maxlines DO BEGIN Changes[Temp_Line]:=0; FOR Temp_Col:=1 TO Maxcol DO BEGIN My_C:=My_Screen[Temp_Line,Temp_Col]; His_Screen[Temp_Line,Temp_Col]:=' '; IF My_C<>' ' THEN BEGIN Any_Changes:=TRUE; Changes[Temp_Line]:=Changes[Temp_Line]+1; END; END; END; Clear_Screen; END ELSE Error('Terminal Not A VT100,VT102,VT200'); C_TS: IF Rep_Count=0 THEN Tabs:=0 ELSE IF Tabs=Maxtabs THEN Error('Maximum Number of Tabs Set') ELSE BEGIN Tabs:=Tabs+1; I:=1; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF I=Tabs THEN BEGIN Tab_Stops[I]:=Rep_Count; Good_Enough:=FALSE; END ELSE IF Tab_Stops[I]>Rep_Count THEN BEGIN I$Move(Tab_Stops[I],Tab_Stops[I+1],Tabs-I); Tab_Stops[I]:=Rep_Count; Good_Enough:=FALSE; END ELSE I:=I+1; END; END; C_TW: IF Term_Type IN [VT100,VT102,VT200] THEN BEGIN IF Term_Type=VT200 THEN Put_String(''(155)'?3h') ELSE Escape('[?3h'); Screen_Width:=132; FOR Temp_Line:=1 TO Maxlines DO BEGIN Changes[Temp_Line]:=0; FOR Temp_Col:=1 TO Maxcol DO BEGIN My_C:=My_Screen[Temp_Line,Temp_Col]; His_Screen[Temp_Line,Temp_Col]:=' '; IF My_C<>' ' THEN BEGIN Any_Changes:=TRUE; Changes[Temp_Line]:=Changes[Temp_Line]+1; END; END; END; Clear_Screen; END ELSE Error('Terminal Not a VT100,VT102,VT200'); C_UNDC,C_UNDW,C_UNDL,C_PASTE,C_UNDD: WHILE Rep_Count>0 DO BEGIN Rep_Count:=Rep_Count-1; IF Command=C_UNDC THEN Move_From(Pad,B_Char,L_Char) ELSE IF Command=C_UNDW THEN Move_From(Pad,B_Word,L_Word) ELSE IF Command=C_UNDL THEN Move_From(Pad,B_Line,L_Line) ELSE IF Command=C_PASTE THEN Move_From(Pad,B_Paste,L_Paste) ELSE IF Command=C_UNDD THEN Move_From(Pad,B_Delete,L_Delete); END; C_Z: BEGIN Buf_Reset(Main); This_Line:=1; This_Pos:=1; Before_Got:=0; After_Got:=0; My_Pos:=1; Sel_Pos:=0; My_Line:=1; My_Col:=1; I$Fill(Marks[1],Maxmarks,0); Fill_Screen(1,1,Maxcol+1,1,1); END; END; L_Command:=Command; END; [GLOBAL] PROCEDURE Ex_NULL; {Implements the null commands which moves around} BEGIN Direction:=Sign; Ent_Count:=Ent_Count*Rep_Count; Rep_Count:=1; Ex_Entity; Move_Cursor(Ent_Pos-My_Pos); L_Command:=C_NULL; END; [GLOBAL] PROCEDURE Ex_CIRCUMFLEX; {Inserts a control character} VAR Com_Char: CHAR; I: INTEGER; BEGIN L_Command:=C_CIRCUMFLEX; IF Com.Pos>Com.Bufsize THEN Error('Character Missing') ELSE BEGIN Com_Char:=Com_Ch_get; IF Com_Char IN Alpha_U THEN BEGIN FOR I:=1 TO Rep_Count DO IF Com_Char='M' THEN Ins_Char(CHR(128)) ELSE Ins_Char(CHR(ORD(Com_Char)-64)); END ELSE Error('Illegal Character'); END; END; PROCEDURE Com_Parse; {Parses input in the command buffer} LABEL 1; VAR Com_Char: CHAR; Com_String: STRING; R_Count, E_Count, R_Pos, Com_State: INTEGER; BEGIN Buf_Goto(Com,P); WITH Com DO BEGIN Com_State:=1; WHILE Com.Pos<=Com.Bufsize DO BEGIN IF Error_Flag THEN GOTO 1; Com_Char:=Com_Ch_Get; IF Com_Char IN Alpha_L THEN Com_Char:=CHR(ORD(Com_Char)-32); IF Com_Char=')' THEN BEGIN IF (P=1) OR (Com_State<>1) THEN Error('No Matching Left Paranthesis'); GOTO 1; END ELSE CASE Com_State OF 1: BEGIN Rep_Count:=1; Ent_Count:=1; Buf_Goto(Main,My_Pos); Sign:=Def_Direction; IF Com_Char IN Plus_Minus THEN BEGIN IF Com_Char='+' THEN Sign:=Plus ELSE IF Com_Char='-' THEN Sign:=Minus; Com_State:=2; END ELSE IF Com_Char IN Digits THEN BEGIN Rep_Count:=ORD(Com_Char)-ORD('0'); Com_State:=3; END ELSE IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; IF Get_Command(Com_String) THEN BEGIN Ex_Command; Com_State:=1; END ELSE IF Get_Entity(Com_String) THEN BEGIN Ent_Count:=Rep_Count; Rep_Count:=1; Command:=C_NULL; Ex_NULL; Com_State:=1; END ELSE Com_State:=4; END ELSE IF Com_Char='^' THEN BEGIN Command:=C_CIRCUMFLEX; Ex_CIRCUMFLEX; Com_State:=1; END ELSE IF Com_Char='"' THEN BEGIN Command:=C_NULL; Entity:=E_QUOTE; Ex_NULL; Com_State:=1; END ELSE IF Com_Char='(' THEN BEGIN E_Count:=Rep_Count; R_Pos:=Com.Pos; FOR R_Count:=1 TO E_Count DO Com_Parse(R_Pos); Com_State:=1; END ELSE IF Com_Char<>' ' THEN Error('Illegal Character in Command'); END; 2: BEGIN IF Com_Char IN Digits THEN BEGIN Rep_Count:=ORD(Com_Char)-ORD('0'); Com_State:=3; END ELSE IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; IF Get_Command(Com_String) THEN BEGIN Ex_Command; Com_State:=1; END ELSE IF Get_Entity(Com_String) THEN BEGIN Ent_Count:=Rep_Count; Rep_Count:=1; Command:=C_NULL; Ex_NULL; Com_State:=1; END ELSE Com_State:=4; END ELSE IF Com_Char='^' THEN BEGIN Command:=C_CIRCUMFLEX; Ex_CIRCUMFLEX; Com_State:=1; END ELSE IF Com_Char='"' THEN BEGIN Command:=C_NULL; Entity:=E_QUOTE; Ex_NULL; Com_State:=1; END ELSE IF Com_Char='(' THEN BEGIN E_Count:=Rep_Count; R_Pos:=Com.Pos; FOR R_Count:=1 TO E_Count DO Com_Parse(R_Pos); Com_State:=1; END ELSE Error('Illegal Character in Command'); END; 3: BEGIN IF Com_Char IN Plus_Minus THEN BEGIN IF Com_Char='+' THEN Sign:=Plus ELSE IF Com_Char='-' THEN Sign:=Minus; Com_State:=5; END ELSE IF Com_Char IN Digits THEN BEGIN Rep_Count:=Rep_Count*10+ORD(Com_Char)-ORD('0'); END ELSE IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; IF Get_Command(Com_String) THEN BEGIN Ex_Command; Com_State:=1; END ELSE IF Get_Entity(Com_String) THEN BEGIN Ent_Count:=Rep_Count; Rep_Count:=1; Command:=C_NULL; Ex_NULL; Com_State:=1; END ELSE Com_State:=4; END ELSE IF Com_Char='^' THEN BEGIN Command:=C_CIRCUMFLEX; Ex_CIRCUMFLEX; Com_State:=1; END ELSE IF Com_Char='"' THEN BEGIN Command:=C_NULL; Entity:=E_QUOTE; Ex_NULL; Com_State:=1; END ELSE IF Com_Char='(' THEN BEGIN E_Count:=Rep_Count; R_Pos:=Com.Pos; FOR R_Count:=1 TO E_Count DO Com_Parse(R_Pos); Com_State:=1; END ELSE Error('Illegal Character in Command'); END; 4: BEGIN IF Com_Char IN Alpha_U THEN BEGIN Com_String:=Com_String+' '; Com_String[LENGTH(Com_String)]:=Com_Char; IF Get_Command(Com_String) THEN BEGIN Ex_Command; Com_State:=1; END ELSE IF Get_Entity(Com_String) THEN BEGIN Ent_Count:=Rep_Count; Rep_Count:=1; Command:=C_NULL; Ex_NULL; Com_State:=1; END; END ELSE Error('Illegal Character in Command'); END; 5: BEGIN IF Com_Char IN Digits THEN BEGIN Ent_Count:=ORD(Com_Char)-ORD('0'); Com_State:=6; END ELSE IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; IF Get_Entity(Com_String) THEN BEGIN Command:=C_NULL; Ex_NULL; Com_State:=1; END ELSE Com_State:=7; END ELSE Error('Illegal Character in Command'); END; 6: BEGIN IF Com_Char IN Digits THEN BEGIN Ent_Count:=Ent_Count*10+ORD(Com_Char)-ORD('0'); END ELSE IF Com_Char IN Alpha_U THEN BEGIN Com_String:=' '; Com_String[1]:=Com_Char; IF Get_Entity(Com_String) THEN BEGIN Command:=C_NULL; Ex_NULL; Com_State:=1; END ELSE Com_State:=7; END ELSE Error('Illegal Character in Command'); END; 7: BEGIN IF Com_Char IN Alpha_U THEN BEGIN Com_String:=Com_String+' '; Com_String[LENGTH(Com_String)]:=Com_Char; IF Get_Entity(Com_String) THEN BEGIN Command:=C_NULL; Ex_NULL; Com_State:=1; END; END ELSE Error('Illegal Character in Command'); END; END; END; IF Com_State<>1 THEN Error('Command Syntax Error'); END; 1: END; [GLOBAL] PROCEDURE Do_Change; {Keeps reading commands until we don't want any more} VAR C_Ord: INTEGER; C: CHAR; C_Type: Char_Type; C_Index: INTEGER; PROCEDURE Getnum; {Gets a number from the keyboard} VAR Save_Line, Save_Col, Com_Col, Tmp_Col, Com_Pos: INTEGER; Good_Enough: BOOLEAN; BEGIN Save_Line:=My_Line; Save_Col:=My_Col; My_Line:=Maxlines; My_Col:=1; OPT_L_Erase; Com_Col:=My_Col; Com_Pos:=Com.Pos; Good_Enough:=TRUE; WHILE Good_Enough DO BEGIN IF (C_Type=Ch_Char) OR (C_Type=Ch_G_Char) THEN BEGIN IF C IN ['+','-','0'..'9'] THEN BEGIN Buf_Put(Com,C); OPT_Put_Char(C); END ELSE Good_Enough:=FALSE; END ELSE IF C_Type=Ch_Cont THEN BEGIN IF C=''(21)'' THEN BEGIN Tmp_Col:=My_Col; My_Col:=Com_Col; Buf_Goto(Com,Com_Pos); WHILE My_Col<>Tmp_Col DO BEGIN C:=Buf_Del(Com); OPT_Put_Char(' '); END; My_Line:=Save_Line; My_Col:=Save_Col; Error('Input Aborted'); Good_Enough:=FALSE; END ELSE IF C=''(127)'' THEN BEGIN IF Com.Pos>Com_Pos THEN BEGIN Buf_Goto(Com,Com.Pos-1); C:=Buf_Del(Com); My_Col:=My_Col-1; OPT_Put_Char(' '); My_Col:=My_Col-1; END; END ELSE Good_Enough:=FALSE; END ELSE Good_Enough:=FALSE; IF Good_Enough THEN BEGIN C_Type:=Get_Key(C,C_Index); C_Ord:=ORD(C); END; END; My_Line:=Save_Line; My_Col:=Save_Col; END; BEGIN REPEAT Com_Begin:=TRUE; Com_End:=FALSE; Error_Flag:=FALSE; REPEAT Do_Echo:=(Com.Pos=1) AND (My_Col>Last_Col[My_Line]) AND (NOT Recover_Flag) AND (Right_Margin=0); IF Do_Echo THEN BEGIN C_Type:=Get_Key(C,C_Index); IF C_Type=Ch_Char THEN BEGIN Buf_Goto(Main,My_Pos); IF Main.Pos>Main.Bufsize THEN BEGIN Ins_Char(''(128)''); Move_Cursor(-1); END; IF (His_Line<>My_Line) OR (His_Col<>My_Col) THEN Opt_Move_Cursor(My_Line,My_Col); IF Echo THEN Put_Char(C); Out_Zap; T$Startmany(In_Buffer,Rec_Length); REPEAT Buf_Put(Com,C); Ins_Q_Char(C); C_Type:=Get_Key(C,C_Index); UNTIL C_Type<>Ch_Char; WITH Com DO BEGIN Buf_Goto(Com,1); Buf_Copy(Com,Main,Bufsize); I$Add(After_Pos[1],After_Got,Bufsize); Mark_Adj(Bufsize); My_Pos:=My_Pos+Bufsize; Buf_Reset(Com); END; END; END ELSE BEGIN C_Type:=Get_Key(C,C_Index); IF (C_Type=Ch_Char) AND (Com.Pos=1) THEN BEGIN IF My_Col>Last_Col[My_Line] THEN BEGIN Buf_Goto(Main,My_Pos); IF Main.Pos>Main.Bufsize THEN BEGIN Ins_Char(''(128)''); Move_Cursor(-1); END; REPEAT Buf_Put(Com,C); Ins_A_Char(C); C_Type:=Get_Key(C,C_Index); UNTIL C_Type<>Ch_Char; IF Com.Bufsize<>0 THEN WITH Com DO BEGIN Buf_Goto(Com,1); Buf_Copy(Com,Main,Bufsize); I$Add(After_Pos[1],After_Got,Bufsize); Mark_Adj(Bufsize); My_Pos:=My_Pos+Bufsize; Buf_Reset(Com); END; END; END; END; C_Ord:=ORD(C); IF (C_Type=Ch_G_Char) AND (C IN ['+','-','0'..'9']) THEN Getnum; CASE C_Type OF Ch_Char: BEGIN IF Com.Pos=1 THEN BEGIN Buf_Goto(Main,My_Pos); Ins_Char(C); END ELSE BEGIN Buf_Put(Com,'I'); Buf_Put(Com,C); Buf_Put(Com,''(26)''); Com_End:=TRUE; END; END; Ch_G_Char: BEGIN Get_Pad(G_Char_Start[C_Index],G_Char_Length[C_Index]); END; Ch_Cont: BEGIN Get_Pad(Cont_Start[C_Index],Cont_Length[C_Index]); END; Ch_G_Cont: BEGIN Get_Pad(G_Cont_Start[C_Index],G_Cont_Length[C_Index]); END; Ch_Pad: BEGIN Get_Pad(Pad_Start[C_Index],Pad_Length[C_Index]); END; Ch_G_Pad: BEGIN Get_Pad(G_Pad_Start[C_Index],G_Pad_Length[C_Index]); END; Ch_Undef: BEGIN Error('Undefined Character'); END; END; UNTIL Com_End OR Error_Flag; IF Com.Bufsize<>0 THEN BEGIN IF NOT Error_Flag THEN Com_Parse(1); Buf_Reset(Com); END; UNTIL ((Command=C_EX) OR (Command=C_QUIT)) AND (NOT Error_Flag); END; [GLOBAL] PROCEDURE Ex_Com_File; VAR Edit_File: FILE OF Long_String; Edit_Line: Long_String; Line_Length: INTEGER; BEGIN OPEN(Edit_File,Com_Name,READONLY,ERROR:=CONTINUE,RECORD_LENGTH:=255); RESET(Edit_File,ERROR:=CONTINUE); IF STATUS(Edit_File)<=0 THEN WITH Com DO BEGIN WHILE (NOT EOF(Edit_File)) AND (NOT Error_Flag) DO BEGIN READ(Edit_File,Edit_Line); WHILE LENGTH(Edit_Line)>0 DO BEGIN IF Memsize=Memmax THEN Out_Buf(Com); Line_Length:=LENGTH(Edit_Line); IF Line_Length>Memmax-Memsize THEN Line_Length:=Memmax-Memsize; L$Move(Edit_Line.BODY,Membuf[Memptr],Line_Length); Bufsize:=Bufsize+Line_Length; Memsize:=Memsize+Line_Length; Memptr:=Memptr+Line_Length; Pos:=Pos+Line_Length; Edit_Line:=SUBSTR(Edit_Line,Line_Length,LENGTH(Edit_Line)-Line_Length); END; Com_Parse(1); Buf_Reset(Com); END; CLOSE(Edit_File); END; END; [GLOBAL] FUNCTION Sedtpurg:INTEGER; {Closes down an edit session} VAR I: INTEGER; BEGIN FOR I:=1 TO Maxbuffers DO IF I<>Current_Buffer THEN Buf_Purge(Save_Main[I]); Buf_Purge(Main); Buf_Purge(Com); Buf_Purge(Pad); IF Journal_Flag THEN CLOSE(Journal_File,DELETE,ERROR:=CONTINUE); Sedtpurg:=1; END; [GLOBAL] FUNCTION Sedt(In_Length:INTEGER;In_String:Character_Array; Out_Length:INTEGER;Out_String:Character_Array; Terminal:Term_Types; Com_Length:INTEGER;Com_String:Character_Array;Recover:BOOLEAN):INTEGER; {Does the first edit session} VAR Edit_File: FILE OF Long_String; Line_Index, Line_Length, I, J: INTEGER; In_C: CHAR; Edit_Line: Long_String; PROCEDURE Sedt_Put_Pad(VAR P_Start, P_Length: INTEGER; S: String); {Inserts a string into the database of key definitions} VAR O, L: INTEGER; BEGIN P_Length:=LENGTH(S); P_Start:=Pad.Pos; WITH Pad DO BEGIN O:=P_Length; WHILE O>0 DO BEGIN IF Memsize=Memmax THEN Out_Buf(Pad); IF O>Memmax-Memsize THEN L:=Memmax-Memsize ELSE L:=O; IF Memsize>=Memptr THEN C$Move(Membuf[Memptr],Membuf[Memptr+L],Memsize-Memptr+1); X$Move(S.BODY,Membuf[Memptr],L); Bufsize:=Bufsize+L; Memsize:=Memsize+L; Memptr:=Memptr+L; Pos:=Pos+L; Modified:=TRUE; O:=O-L; IF O<>0 THEN S:=SUBSTR(S,L,LENGTH(S)-L); END; END; END; BEGIN T$Init; Term_Type:=Terminal; Out_Size:=0; CASE Term_Type OF VT100,VT102: BEGIN Scroll_Top:=0; Set_Scroll(1,Maxlines); Screen_Width:=80; Escape('='); Escape('[?7l'); END; VT200: BEGIN Scroll_Top:=0; Screen_Width:=80; Escape('[62"p'); Escape(' F'); Escape('='); Set_Scroll(1,Maxlines); Put_String(''(155)'?7l'); END; VK100: BEGIN Screen_Width:=84; Escape('='); Escape('[?7l'); END; VT52: BEGIN Screen_Width:=80; Escape('='); END; END; Out_Zap; In_Size:=0; In_Index:=0; Version:='Version 1.0 (6)'; Alpha:=['a'..'z','A'..'Z',''(192)''..''(221)'',''(224)''..''(253)'']; Alpha_U:=['A'..'Z',''(192)''..''(221)'']; Alpha_L:=['a'..'z',''(224)''..''(253)'']; Plus_Minus:=['+','-']; Digits:=['0'..'9']; Printable:=[' '..'~',''(161)''..''(254)'']; Non_Printable:=[''(0)''..''(31)'',''(127)''..''(159)'']; Mode:=1; Word_Delim:=[''(0)''..'/',':'..'@','['..'^','`','{'..''(128)'']; Input_Name.LENGTH:=In_Length; IF In_Length<>0 THEN S$Move(In_String[1],Input_Name.BODY,In_Length); IF Out_Length=0 THEN BEGIN Output_Name.LENGTH:=In_Length; IF In_Length<>0 THEN S$Move(In_String[1],Output_Name.BODY,In_Length); END ELSE BEGIN Output_Name.LENGTH:=Out_Length; S$Move(Out_String[1],Output_Name.BODY,Out_Length); END; Before_Got:=0; After_Got:=0; Current_Buffer:=1; FOR I:=1 TO Maxbuffers DO Save_Used[I]:=FALSE; Buf_Init(Main); Main.I_File:=1; Main.O_File:=1; Buf_Init(Com); Com.I_File:=Maxbuffers+1; Com.O_File:=Maxbuffers+1; Buf_Init(Pad); Pad.I_File:=Maxbuffers+2; Pad.O_File:=Maxbuffers+2; OPT_Init; Journal_Flag:=TRUE; I:=INDEX(Input_Name,']'); Journal_Name:=SUBSTR(Input_Name,I+1,In_Length-I); REPEAT J:=INDEX(Journal_Name,':'); IF J<>0 THEN Journal_Name:=SUBSTR(Journal_Name,J+1,LENGTH(Journal_Name)-J); UNTIL J=0; J:=INDEX(Journal_Name,'.'); IF J=0 THEN Journal_Name:=Journal_Name+'.JOU' ELSE Journal_Name:=SUBSTR(Journal_Name,1,J-1)+'.JOU'; Recover_Flag:=Recover; IF Recover_Flag THEN BEGIN OPEN(Journal_File,Journal_Name,OLD,ERROR:=CONTINUE); RESET(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN Recover_Flag:=FALSE ELSE Error('Rebuilding from Journal File'); END; IF NOT Recover_Flag THEN BEGIN OPEN(Journal_File,Journal_Name,NEW,ERROR:=CONTINUE); REWRITE(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Opening Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; Load_File; B_Char:=0; B_Word:=0; B_Line:=0; B_Paste:=0; B_Delete:=0; B_Search:=0; B_Subs:=0; Left_Margin:=0; Tabs:=0; Right_Margin:=0; Cursor_Top:=8; Cursor_Bottom:=16; Cursor_Middle:=12; Any_Changes:=(Com_Length<>0) OR Recover; Opt_Update(1,Maxlines); Out_Zap; Def_Direction:=Plus; I$Fill(Pad_Start[0],22,0); I$Fill(Pad_Length[0],22,0); I$Fill(G_Pad_Start[0],22,0); I$Fill(G_Pad_Length[0],22,0); I$Fill(Cont_Start[0],128,0); I$Fill(Cont_Length[0],128,0); I$Fill(G_Cont_Start[0],128,0); I$Fill(G_Cont_Length[0],128,0); I$Fill(G_Char_Start[33],255-33+1,0); I$Fill(G_Char_Length[33],255-33+1,0); I$Fill(Marks[1],Maxmarks,0); Sedt_Put_Pad(Cont_Start[ORD('A')-64],Cont_Length[ORD('A')-64],'TC.'); Sedt_Put_Pad(Cont_Start[ORD('D')-64],Cont_Length[ORD('D')-64],'TD.'); Sedt_Put_Pad(Cont_Start[ORD('E')-64],Cont_Length[ORD('E')-64],'TI.'); Sedt_Put_Pad(Cont_Start[ORD('H')-64],Cont_Length[ORD('H')-64],'BL.'); Sedt_Put_Pad(Cont_Start[ORD('I')-64],Cont_Length[ORD('I')-64],'TAB.'); Sedt_Put_Pad(Cont_Start[ORD('J')-64],Cont_Length[ORD('J')-64],'DELBW.'); Sedt_Put_Pad(Cont_Start[ORD('K')-64],Cont_Length[ORD('K')-64], 'DEFK!'(39)'Key:'(39)''(0)'?'(39)'As:'(39)''(0)'.'); Sedt_Put_Pad(Cont_Start[ORD('L')-64],Cont_Length[ORD('L')-64],'^L.'); Sedt_Put_Pad(Cont_Start[ORD('M')-64],Cont_Length[ORD('M')-64],'^M.'); Sedt_Put_Pad(Cont_Start[ORD('U')-64],Cont_Length[ORD('U')-64],'DELBL.'); Sedt_Put_Pad(Cont_Start[ORD('W')-64],Cont_Length[ORD('W')-64],'REF.'); Sedt_Put_Pad(Cont_Start[ORD('Z')-64],Cont_Length[ORD('Z')-64],'?'(39)'*'(39)'.'); Sedt_Put_Pad(Cont_Start[ORD('[')-64],Cont_Length[ORD('[')-64],'27ASC.'); Sedt_Put_Pad(Cont_Start[127],Cont_Length[127],'DEL-CH.'); Sedt_Put_Pad(G_Cont_Start[127],G_Cont_Length[127],'DELBW.'); Sedt_Put_Pad(Pad_Start[0],Pad_Length[0],'L.'); Sedt_Put_Pad(G_Pad_Start[0],G_Pad_Length[0],'(^M-CH).'); Sedt_Put_Pad(Pad_Start[1],Pad_Length[1],'W.'); Sedt_Put_Pad(G_Pad_Start[1],G_Pad_Length[1],'CGC+CH.'); Sedt_Put_Pad(Pad_Start[2],Pad_Length[2],'EL.'); Sedt_Put_Pad(G_Pad_Start[2],G_Pad_Length[2],'DEL+EL.'); Sedt_Put_Pad(Pad_Start[3],Pad_Length[3],'CH.'); Sedt_Put_Pad(G_Pad_Start[3],G_Pad_Length[3],'ASC.'); Sedt_Put_Pad(Pad_Start[4],Pad_Length[4],'ADV.'); Sedt_Put_Pad(G_Pad_Start[4],G_Pad_Length[4],'ER.'); Sedt_Put_Pad(Pad_Start[5],Pad_Length[5],'BACK.'); Sedt_Put_Pad(G_Pad_Start[5],G_Pad_Length[5],'BR.'); Sedt_Put_Pad(Pad_Start[6],Pad_Length[6],'CUT.'); Sedt_Put_Pad(G_Pad_Start[6],G_Pad_Length[6],'PASTE.'); Sedt_Put_Pad(Pad_Start[7],Pad_Length[7],'PAGE.'); Sedt_Put_Pad(G_Pad_Start[7],G_Pad_Length[7],'?'(39)'Command: '(39)'.'); Sedt_Put_Pad(Pad_Start[8],Pad_Length[8],'(8L).'); Sedt_Put_Pad(G_Pad_Start[8],G_Pad_Length[8],'TFSR.'); Sedt_Put_Pad(Pad_Start[9],Pad_Length[9],'SN.'); Sedt_Put_Pad(G_Pad_Start[9],G_Pad_Length[9], 'SUB'(0)'?'(39)'Object: '(39)''(0)'?'(39)'By: '(39)''(0)'.'); Sedt_Put_Pad(Pad_Start[10],Pad_Length[10],'HELP.'); Sedt_Put_Pad(G_Pad_Start[10],G_Pad_Length[10],'HELP.'); Sedt_Put_Pad(Pad_Start[11],Pad_Length[11],'NS.'); Sedt_Put_Pad(G_Pad_Start[11],G_Pad_Length[11], '"'(0)'?'(39)'Search for: '(39)''(0)'.'); Sedt_Put_Pad(Pad_Start[12],Pad_Length[12],'-V.'); Sedt_Put_Pad(G_Pad_Start[12],G_Pad_Length[12],'BR.'); Sedt_Put_Pad(Pad_Start[13],Pad_Length[13],'+V.'); Sedt_Put_Pad(G_Pad_Start[13],G_Pad_Length[13],'ER.'); Sedt_Put_Pad(Pad_Start[14],Pad_Length[14],'+CH.'); Sedt_Put_Pad(G_Pad_Start[14],G_Pad_Length[14],'+EL.'); Sedt_Put_Pad(Pad_Start[15],Pad_Length[15],'-CH.'); Sedt_Put_Pad(G_Pad_Start[15],G_Pad_Length[15],'-BL.'); Sedt_Put_Pad(Pad_Start[16],Pad_Length[16],'SEL.'); Sedt_Put_Pad(G_Pad_Start[16],G_Pad_Length[16],'RES.'); Sedt_Put_Pad(Pad_Start[17],Pad_Length[17],'DEL+L.'); Sedt_Put_Pad(G_Pad_Start[17],G_Pad_Length[17],'UNDL.'); Sedt_Put_Pad(Pad_Start[18],Pad_Length[18],'DEL+W.'); Sedt_Put_Pad(G_Pad_Start[18],G_Pad_Length[18],'UNDW.'); Sedt_Put_Pad(Pad_Start[19],Pad_Length[19],'DEL+CH.'); Sedt_Put_Pad(G_Pad_Start[19],G_Pad_Length[19],'UNDC.'); Sedt_Put_Pad(G_Pad_Start[21],G_Pad_Length[21],'SN.'); IF Term_Type IN [VT100,VT200] THEN BEGIN Sedt_Put_Pad(Pad_Start[22],Pad_Length[22],'NS.'); Sedt_Put_Pad(G_Pad_Start[22],G_Pad_Length[22], '"'(0)'?'(39)'Search for: '(39)''(0)'.'); Sedt_Put_Pad(Pad_Start[23],Pad_Length[23],'PASTE.'); Sedt_Put_Pad(G_Pad_Start[23],G_Pad_Length[23],'(^M-CH).'); Sedt_Put_Pad(Pad_Start[24],Pad_Length[24],'CUT.'); Sedt_Put_Pad(G_Pad_Start[24],G_Pad_Length[24],'DEL+L.'); Sedt_Put_Pad(Pad_Start[25],Pad_Length[25],'SEL.'); Sedt_Put_Pad(Pad_Start[26],Pad_Length[26],'(-16L).'); Sedt_Put_Pad(G_Pad_Start[26],G_Pad_Length[26],'(-PAGE).'); Sedt_Put_Pad(Pad_Start[27],Pad_Length[27],'(+16L).'); Sedt_Put_Pad(G_Pad_Start[27],G_Pad_Length[27],'(+PAGE).'); Sedt_Put_Pad(Pad_Start[34],Pad_Length[34],'27ASC.'); Sedt_Put_Pad(Pad_Start[35],Pad_Length[35],'BL.'); Sedt_Put_Pad(Pad_Start[36],Pad_Length[36],'DELBW.'); Sedt_Put_Pad(Pad_Start[39],Pad_Length[39],'HELP.'); Sedt_Put_Pad(Pad_Start[42],Pad_Length[42],'1EB.'); Sedt_Put_Pad(Pad_Start[43],Pad_Length[43],'2EB.'); Sedt_Put_Pad(Pad_Start[44],Pad_Length[44],'3EB.'); Sedt_Put_Pad(Pad_Start[45],Pad_Length[45],'4EB.'); END; Sedt_Put_Pad(G_Char_Start[ORD('B')],G_Char_Length[ORD('B')], '?'(39)'Buffer Number: '(39)'EB.'); Sedt_Put_Pad(G_Char_Start[ORD('C')],G_Char_Length[ORD('C')],'CEN.'); Sedt_Put_Pad(G_Char_Start[ORD('D')],G_Char_Length[ORD('D')],'DI.'); Sedt_Put_Pad(G_Char_Start[ORD('E')],G_Char_Length[ORD('E')], 'FE'(0)'?'(39)'File: '(39)''(0)'.'); Sedt_Put_Pad(G_Char_Start[ORD('F')],G_Char_Length[ORD('F')],'EX.'); Sedt_Put_Pad(G_Char_Start[ORD('G')],G_Char_Length[ORD('G')],'GOTO.'); Sedt_Put_Pad(G_Char_Start[ORD('I')],G_Char_Length[ORD('I')], 'FI'(0)'?'(39)'File: '(39)''(0)'.'); Sedt_Put_Pad(G_Char_Start[ORD('L')],G_Char_Length[ORD('L')], '?'(39)'Left Margin at: '(39)'ML.'); Sedt_Put_Pad(G_Char_Start[ORD('M')],G_Char_Length[ORD('M')],'MARK.'); Sedt_Put_Pad(G_Char_Start[ORD('N')],G_Char_Length[ORD('N')],'TN.'); Sedt_Put_Pad(G_Char_Start[ORD('O')],G_Char_Length[ORD('O')], 'FO'(0)'?'(39)'File: '(39)''(0)'.'); Sedt_Put_Pad(G_Char_Start[ORD('Q')],G_Char_Length[ORD('Q')],'QUIT.'); Sedt_Put_Pad(G_Char_Start[ORD('R')],G_Char_Length[ORD('R')], '?'(39)'Right Margin at: '(39)'MR.'); Sedt_Put_Pad(G_Char_Start[ORD('S')],G_Char_Length[ORD('S')], 'FW'(0)'?'(39)'File: '(39)''(0)'.'); Sedt_Put_Pad(G_Char_Start[ORD('T')],G_Char_Length[ORD('T')],'TS.'); Sedt_Put_Pad(G_Char_Start[ORD('U')],G_Char_Length[ORD('U')],'%MCH.'); Sedt_Put_Pad(G_Char_Start[ORD('W')],G_Char_Length[ORD('W')],'TW.'); Sedt_Put_Pad(G_Char_Start[ORD('Z')],G_Char_Length[ORD('Z')],'Z.'); Sedt_Put_Pad(G_Char_Start[ORD('?')],G_Char_Length[ORD('?')],'STA.'); IF Com_Length<>0 THEN BEGIN Error_Flag:=FALSE; Com_Name.LENGTH:=Com_Length; S$Move(Com_String[1],Com_Name.BODY,Com_Length); Ex_Com_File; END; Opt_Update(1,Maxlines); Out_Zap; IF NOT Recover_Flag THEN T$Start(In_Buffer,Rec_Length); Got_Char:=TRUE; REPEAT Do_Change; T$Cancel; IF Command=C_EX THEN IF LENGTH(Output_Name)<>0 THEN Save_File(Output_Name); IF Error_Flag THEN T$Start(In_Buffer,Rec_Length); UNTIL NOT Error_Flag; IF Journal_Flag AND (Command=C_EX) THEN CLOSE(Journal_File,DELETE); Clear_Screen; Set_Cursor(1,1); Out_Zap; CASE Term_Type OF VT100,VT102: BEGIN Set_Scroll(1,Maxlines); Escape('>'); Out_Zap; END; VT200: BEGIN Set_Scroll(1,Maxlines); Escape('[61"p'); Escape('>'); Out_Zap; END; VK100,VT52: BEGIN Escape('>'); Out_Zap; END; END; Sedt:=1; END; [GLOBAL] FUNCTION Sedtrest(In_Length:INTEGER;In_String:Character_Array; Out_Length:INTEGER;Out_String:Character_Array; Com_Length:INTEGER;Com_String:Character_Array):INTEGER; {Does subsequent edit sessions} VAR Edit_File: FILE OF Long_String; Line_Length, I, J: INTEGER; Edit_Line: Long_String; BEGIN CASE Term_Type OF VT100,VT102: BEGIN Escape('='); Escape('[?7l'); Set_Scroll(1,Maxlines); END; VT200: BEGIN Escape('[62"p'); Escape(' F'); Escape('='); Set_Scroll(1,Maxlines); Put_String(''(155)'?7l'); END; VK100: BEGIN Escape('='); Escape('[?7l'); END; VT52: Escape('='); END; IF Journal_Flag AND (Command=C_EX) THEN BEGIN OPEN(Journal_File,Journal_Name,NEW,ERROR:=CONTINUE); REWRITE(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Opening Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; IF In_Length<>0 THEN BEGIN Input_Name.LENGTH:=In_Length; S$Move(In_String[1],Input_Name.BODY,In_Length); Load_File; IF Journal_Flag THEN BEGIN CLOSE(Journal_File,DELETE); In_Length:=LENGTH(Input_Name); I:=INDEX(Input_Name,']'); Journal_Name:=SUBSTR(Input_Name,I+1,In_Length-I); REPEAT J:=INDEX(Journal_Name,':'); IF J<>0 THEN Journal_Name:=SUBSTR(Journal_Name,J+1,LENGTH(Journal_Name)-J); UNTIL J=0; J:=INDEX(Journal_Name,'.'); IF J=0 THEN Journal_Name:=Journal_Name+'.JOU' ELSE Journal_Name:=SUBSTR(Journal_Name,1,J-1)+'.JOU'; OPEN(Journal_File,Journal_Name,NEW,ERROR:=CONTINUE); REWRITE(Journal_File,ERROR:=CONTINUE); IF STATUS(Journal_File)>0 THEN BEGIN Error('Error Opening Journal File'); Journal_Flag:=FALSE; END; Journal_Length:=0; END; END; IF Out_Length<>0 THEN BEGIN Output_Name.LENGTH:=Out_Length; S$Move(Out_String[1],Output_Name.BODY,Out_Length); END; In_Size:=0; In_Index:=0; Command:=C_REF; Ex_Command; Opt_Update(1,Maxlines); Out_Zap; IF Com_Length<>0 THEN BEGIN Error_Flag:=FALSE; Com_Name.LENGTH:=Com_Length; S$Move(Com_String[1],Com_Name.BODY,Com_Length); Ex_Com_File; END; T$Start(In_Buffer,Rec_Length); REPEAT Do_Change; T$Cancel; IF Command=C_EX THEN BEGIN IF LENGTH(Output_Name)<>0 THEN Save_File(Output_Name); END; IF Error_Flag THEN T$Start(In_Buffer,Rec_Length); UNTIL NOT Error_Flag; IF Journal_Flag AND (Command=C_EX) THEN CLOSE(Journal_File,DELETE); Clear_Screen; Set_Cursor(1,1); Out_Zap; CASE Term_Type OF VT100,VT102: BEGIN Set_Scroll(1,Maxlines); Escape('>'); Out_Zap; END; VT200: BEGIN Set_Scroll(1,Maxlines); Escape('[61"p'); Escape('>'); Out_Zap; END; VK100,VT52: BEGIN Escape('>'); Out_Zap; END; END; Sedtrest:=1; END; END.