'===========================================================================
' Subject: TEXT EDITOR FOR PB                 Date: 04-21-98 (11:55)       
'  Author: Alexander Podkolzin                Code: PB                     
'  Origin: app@nw.sbank.e-burg.su           Packet: TEXT.ABC
'===========================================================================
'===========================================================================
'
'                       Command line editor (PB3.2+).
'                       ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Athor           : Alexander Podkolzin
' Copyright status: PUBLIC DOMAIN. Use the editor for good health.
'
' My first editor I wrote in 1996, its bad equivalent you can find in ABC.
' Hope this attempt will be better ;)
' This editor is similar to IDE PB3.0 - 3.2 's one. There are more then 200
' "If...Then" statements in the text, so be carefull to change any of them!
' It's still in work...
'
' To my mind the very difficult things in an editor are block operations.
' To test an editor try to copy or move block to different (better to
' outside of bounds of screen, line end, etc.) positions.
'
'                Best wishes from the "ASMB,R,B,L,T" times!
'
'===========================================================================
 $COMPILE EXE
 $DIM ALL
 $CPU 80386      '!!! N.B. !!!         'Check your CPU
 $LIB ALL OFF
 $STRING 1
 $SOUND 1
 $DEBUG MAP OFF
 $FLOAT NPX      '!!! N.B. !!!         'Check if you have it
 $DYNAMIC
 $OPTIMIZE SIZE
'---------------------------------------------------------------------------
 Declare Function GetStrLoc()
 Declare Function fAnswer(String) As Integer
 Declare Function fBlockSize() As Long
 Declare Function fDosUcase(Byval Text As String) As String
 Declare Function fGetKey() As Integer
 Declare Function fMore() As Integer
 Declare Function fTinput(String, String) As String
 Declare Function fWord(String, Integer) As Integer
 Declare Sub BreakLine()
 Declare Sub ClearClipBoard()
 Declare Sub ClearStorage()
 Declare Sub ColorLine(Integer)
 Declare Sub CopyToClipBoard()
 Declare Sub CopyBlockToStorage()
 Declare Sub CorrectBounds(Delta As Integer)
 Declare Sub CorrectionDL()
 Declare Sub CorrectionIL()
 Declare Sub Cprint(Integer, Integer, String, Integer)
 Declare Sub DeleteBlock()
 Declare Sub DeleteChar()
 Declare Sub DeleteChunk(Integer, Integer)
 Declare Sub FindAndReplace(Integer)
 Declare Sub FindBlockType()
 Declare Sub FindSearchBounds()
 Declare Sub HideBlock()
 Declare Sub InsertChar(Integer, Integer, String)
 Declare Sub InsertChunk(Integer, Integer)
 Declare Sub InsertFromClipBoard()
 Declare Sub InsertFromStorage()
 Declare Sub Message(String)
 Declare Sub MoveBlock(Integer)
 Declare Sub ReColor(x As Integer, y As Integer, n As Integer, Attr As Word)
 Declare Sub SaveEditFile()
 Declare Sub SearchMe()
 Declare Sub SetFastCursor()
 Declare Sub SetNormCursor()
 Declare Sub ShowPage()
 Declare Sub TestLine()
'---------------------------------------------------------------------------
 Dim T(0) As Shared String             'Text array
 Dim FileName As Shared String
 Dim BlockFile As Shared String
 Dim PickFile As Shared String
 Dim Fi As Integer
 Dim FileSize As Shared Long
 Dim Lf As Long
 Dim Nlines As Shared Integer
 Dim BegSimb As Shared Integer         'First simbol to show
 Dim BegLine As Shared Integer         'First line to show
 Dim CurX As Shared Integer
 Dim CurY As Shared Integer
 Dim CurLine As Shared Integer
 Dim CurSimb As Shared Integer
 Dim CurLen As Shared Integer
 Dim ScreenSegment As Shared Integer
 Dim Ins As Shared Integer             'Flag "Ins"
 Dim Indnt As Shared Integer           'Unconditional indent
 Dim Indent As Shared Integer          'Auto indent (on/off)
 Dim IsChanged As Shared Integer       'Flag "edit file changed"
 Dim CanBeRestored As Shared Integer
 Dim BakLine As Shared String
 Dim Simb As Shared Integer
 Dim Show As Shared Integer
 Dim i As Integer
 Dim k As Integer
 Dim l As Integer
 Dim m As Integer
 Dim n As Integer
 Dim s As String
 Dim sa As String
 Dim ShiftPressed As Integer
 Dim ShiftByte As Byte Ptr
 Dim ShiftFlag As Integer
 Dim Find As Shared String
 Dim ReplaceWith As Shared String
 Dim Options As Shared String
 Dim SFL As Shared Integer             '= Search From Line
 Dim STL As Shared Integer             '= Search To Line
 Dim SFS As Shared Integer             '= Search From Simbol
 Dim STS As Shared Integer             '= Search To Simbol
 Dim Delimiters As Shared String
 Dim Ruler(2) As String
 Dim GlobalSearch As Shared Integer    'G' Find and replace options:
 Dim LocalSearch As Shared Integer     'L'
 Dim NeedPermission As Shared Integer  'N'
 Dim AnyCase As Shared Integer         'U'
 Dim WholeWords As Shared Integer      'W'
 Dim LenFind As Shared Integer
 Dim LenReplace As Shared Integer
 Dim Counter As Shared Integer
 Dim BlockHere As Shared Integer
 Dim FLB As Shared Integer             '(F)irst (L)ine   of (B)lock
 Dim FSB As Shared Integer             '(F)ist  (S)imbol of (B)lock
 Dim LLB As Shared Integer             '(L)ast  (L)ine   of (B)lock
 Dim LSB As Shared Integer             '(L)ast  (S)imbol of (B)lock
 Dim FLS As Shared Integer             '(F)irst (L)ine of (S)torage
 Dim NS As Shared Integer              '(N)umber of (S)torage lines
 Dim FL As Shared Integer              '(F)ull (L)ines in block
 Dim BlockType As Shared Integer       '
 Dim BlockSize As Shared Long          '
 Dim NC As Shared Integer              '(N)umber of (C)lipboard lines
 Dim Nt As Shared Integer              'Normal text
 Dim Na As Shared Integer              'Normal attribute
 Dim Bt As Shared Integer              'Block text
 Dim Ba As Shared Integer              'Block attribute
 Dim Dt As Shared Integer              'Down line text
 Dim Da As Shared Integer              'Down line attribute
'---------------------------------------------------------------------------
 %MaxLines = 10000 '<- Wrong approach! '<--- We use it here as PB3.2 has no
'--------------------------------------'     REDIM PRESERVE statement
'          Short explanations:         '
'                                      '
'               Array T()              '
'          |~~~~~~~~~~~~~~~~~| 1       '
'                  ...                 'Position of FLS depends on
'          |       Text      |         'block size
'          |_________________| Nlines  '
'          |                 |         '1 <= Nlines <= %MaxLines
'          |   Unused area   |         '
'          |                 |         'Storage can not occupy more
'          |                 |         'than 1/2 of unused area
'          |                 |         '
'          |~~~~~~~~~~~~~~~~~| FLS      \
'          |     Storage     |           |  NS lines
'          |                 | %MaxLines |
'          +-----------------+          /
'
' Text grows down, Storage grows up. To avoid collapse unused area have
' to be as big as block size...
'
'---------------------------------------------------------------------------
 %Nclip = 23                           'Simplifyed. The keyboard stores whole
 Dim Clip(%Nclip) As Shared String     'strings only
'---------------------------------------------------------------------------
 %AX = 1
 %CX = 3
 %DX = 4
 %DS = 8
 %FALSE = 0
 %TRUE = -1
 %YES = 2
 %NO = 1
 %ABORT = 0
 %Blinking = &H80                      'Blinking...
 %NormAttr = &H07                      'Main colors (Choose your preferences)
 %BlockAttr = &H17                     'Block colors
 %ErrAttr = &H4F                       'Error message colors
 %DownLineAttr = &H1E                  'Colors of down line
 %HideAttr = %DownLineAttr - 8         'Color of unactive status
 %ClipAttr = &H70                      'Clipboard colors
 %MaxLen = 256                         'Max length of string
 %Lpage = 23                           'Length of active page
 %TabSize = 8
 PickFile = ""
'---------------------------------------------------------------------------
 %ESC_key = &H001B
 %ENTER_key = &H000D
 %F01_key = &H3B00
 %F02_key = &H3C00
 %F10_key = &H4400
 %F12_key = &H8600
 %TAB_key = &H0009
 %BCSP_key = &H0008
 %INS_key = &H5200
 %HOME_key = &H4700
 %PGUP_key = &H4900
 %DEL_key = &H5300
 %END_key = &H4F00
 %PGDN_key = &H5100
 %UP_key = &H4800
 %LEFT_key = &H4B00
 %DOWN_key = &H5000
 %RIGHT_key = &H4D00
 %CTRL_PG_UP_key = &H8400
 %CTRL_PG_DOWN_key = &H7600
 %CTRL_HOME_key = &H7700
 %CTRL_END_key = &H7500
 %CTRL_A_key = &H01
 %CTRL_B_key = &H02
 %CTRL_C_key = &H03
 %CTRL_F_key = &H06
 %CTRL_K_key = &H0B
 %CTRL_L_key = &H0C
 %CTRL_N_key = &H0E
 %CTRL_Q_key = &H11
 %CTRL_R_key = &H12
 %CTRL_T_key = &H14
 %CTRL_V_key = &H16
 %CTRL_W_key = &H17
 %CTRL_Y_key = &H19
 %CTRL_INS_key = &H9200
 %CTRL_LEFT_key = &H7300
 %CTRL_RIGHT_key = &H7400
 %ALT_C_key = &H2E00
 %ALT_R_key = &H1300
 %ALT_X_key = &H2D00
 %DelimLine = &H2800                   'ALT + '
'---------------------------------------------------------------------------
 %NeedHelp = %TRUE                     'Adds to EXE-file 2.6 KB

$IF %NeedHelp

 Dim Help(25) As Shared String

 s = Space$(80)
 Mid$(s, 1) = " List of editor commands"
 Help(01) = s
 Help(02) = "--------------------------------------------------------------------------------"
 Help(03) = "Cursor movement| Left arrow, Right arrow, Up arrow, Down arrow, PgUp, PgDn,     "
 Help(04) = "commands (keys)| Home, End, Ctrl-Home, Ctrl-End, Ctrl-PgUp, Ctrl-PgDn,          "
 Help(05) = "               | Ctrl-QB, Ctrl-QK, Ctrl*Left, Ctrl*Right                        "
 Help(06) = "---------------+----------------------------------------------------------------"
 Help(07) = " Block commands| Ctrl*KB, Ctrl*KK, Ctrl-KT, Ctrl-KN, Ctrl-KC, Ctrl-KV, Ctrl-KY, "
 Help(08) = "         (keys)| Ctrl-KR, Ctrl-KW, Ctrl-Ins,                                    "
 Help(09) = "          (CUA)| Ctrl-Ins, Shift-Ins, Shift-Del, Shift*Right arrow, Shift*Home, "
 Help(10) = "               | Shift*Left arrow, Shift*Down arrow, Shift*Up arrow, Shift*End, "
 Help(11) = "---------------+----------------------------------------------------------------"
 Help(12) = "     Insert and| Insert mode on/off = Ins, Insert line = Ctrl*N,                "
 Help(13) = "  delete (keys)| Delete character left=*Backspace, Delete character right = Del "
 Help(14) = "  Miscellaneous| Ruler = Alt-R, Quit edit no save =*F10, Save not quit = F2,    "
 Help(15) = "commands (keys)| Auto indent toggle =*F12, Restore line= Ctrl-QL, Delim.= Alt+' "
 Help(16) = "---------------+----------------------------------------------------------------"
 Help(17) = "Search commands| Search = Ctrl-QF, Search and replace = Ctrl-QA,                "
 Help(18) = "         (keys)| Repeat last search = Ctrl-L  (only FORWARD direction)          "
 Help(19) = "---------------+----------------------------------------------------------------"
 Help(20) = " Search/Replace| G = Globally from the first string, L = Locally from block     "
 Help(21) = "        options| begin to block end, U = Ignore uppercase/lowercase differences,"
 Help(22) = " (FORWARD only)| W = Whole words only, N = Replace without asking.                                    "
 Help(23) = "--------------------------------------------------------------------------------"
 Mid$(s, 1) = "<Line:Chr:ASC>,Last, FileName    Input/Search/Replace/Options area"
 Help(24) = s

'PB unsuppors: Ruler = Alt-R, Delimiter line = Alt+', Show clipboard = Alt-C
'Commands marked with * differ from PB IDE commands, some of them are simplifyed

 %HelpAttr = &H20

$ENDIF
'---------------------------------------------------------------------------

 FileName = Command$

 If Dir$(FileName) = "" Then
   Print "USAGE: MED.EXE <FILE NAME>"
   End
 End If

 If(Pbvscrncard And 1) = 0 Then
   ScreenSegment = &HB800              'Color monitor
 Else
   ScreenSegment = &HB000              'Mono monitor
 End If

 FileName = fDosUcase(Rtrim$(Ltrim$(FileName)))

 Redim T(%MaxLines)                    'Come on!

 FileSize = 0
 If Dir$(FileName) <> "" Then
   Fi = Freefile
   Open FileName For Input As Fi
   Cprint 1, 25, "Loading file...", %NormAttr + %Blinking
   Nlines = 0
   Do While Not Eof(Fi)                'Reading edit file
'
' If string is longer then string segment ($STRING) then Err. 15
'
     Line Input #Fi, s
     Incr FileSize, Len(s) + 2
     Replace Chr$(9) With Space$(%TabSize) In s 'Detab line
     Incr Nlines
     T(Nlines) = Mid$(s, 1, %MaxLen)   'Cut too long strings
   Loop
   Close Fi
   Incr Nlines

 End If

 i = Instr(FileName, ".")
 If i Then
   PickFile = Left$(FileName, i - 1) + ".MPK"
 Else
   PickFile = PickFile + ".MPK"
 End If
'
'Preparing colors according to %constants for "COLOR" statements
'
 i = %NormAttr    : Nt = i And &H0F : Shift Right i, 4 :  Na = i
 i = %BlockAttr   : Bt = i And &H0F : Shift Right i, 4 :  Ba = i
 i = %DownLineAttr: Dt = i And &H0F : Shift Right i, 4 :  Da = i

 ShiftByte = &H0417                    'Shift status address
 IsChanged = %FALSE                    'Flags:
 CanBeRestored = %FALSE                '
 Ins = 1                               '
 Indent = 1                            '
 Show = %TRUE
 BakLine = ""
 Delimiters = " .,;()-+/\*^=<>'`~" + Chr$(34)
 FLS = %MaxLines                       'First Line of Storage

 Ruler(1) = ""
 Ruler(2) = Space$(9)                  'Making electronic ruler:)
 For i = 1 To 25
   Ruler(1) = Ruler(1) + Chr$(7, 7, 7, 7, 124, 7, 7, 7, 7, 179)
   Ruler(2) = Ruler(2) + Left$(Ltrim$(Str$(i * 10)) + Space$(9), 10)
 Next
 Ruler(1) = Ruler(1) + Chr$(7, 7, 7, 7, 124)

 HideBlock

 If Dir$(PickFile) <> "" Then          'If pick file exists,
   Fi = Freefile                       'get pick info
   Open PickFile For Binary As Fi      'Pick file supports only one file
   Get Fi ,, BegSimb
   Get Fi ,, BegLine
   Get Fi ,, CurX
   Get Fi ,, CurY
   Get Fi ,, FSB
   Get Fi ,, FLB
   Get Fi ,, LSB
   Get Fi ,, LLB
   Get Fi ,, BlockHere
   Get Fi ,, Lf
   If FileSize <> Lf Then              'If file is changed!
     HideBlock
     BegSimb = 1
     BegLine = 1
     CurX = 1
     CurY = 1
   End If
   Close Fi
 End If

 Cls
 SetFastCursor                         'I love fast moving
 Cprint 1, 25, Space$(80), %DownLineAttr
'
'The single label in the editor to make problems easy and short
'
 ErrorGate:

 Do

   ShowPage
   T(CurLine) = Rtrim$(T(CurLine))
   CurLen = Len(T(CurLine))
   Simb = fGetKey()

   i = CurLen - Len(Ltrim$(T(CurLine)))
   If CurLen > 0 Then
     Indnt = i
   Else
     Indnt = 0
   End If

   Select Case Simb

$IF %NeedHelp

   Case %F01_key

     Locate ,, 0
     Cprint 1, 1, Help(1), %ClipAttr
     For i = 2 To 23
       Cprint 1, i, Help(i), %HelpAttr
     Next
     Cprint 1, i, Help(24), %ClipAttr
     Simb = fGetKey()
     Locate ,, 1

$ENDIF

   Case %Home_key                      'Start of line

     ShiftFlag = 0
     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed Then
       FLB = CurLine
       LLB = CurLine
       FSB = 1
       LSB = BegSimb + CurX
       If LSB > CurLen Then LSB = CurLen + 1
     Else
       BegSimb = 1
       CurX = 1
       If CurSimb = 1 Then Show = %FALSE
     End If

   Case %End_key                       'End of line

     ShiftFlag = 0
     i = CurLen
     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed Then
       FLB = CurLine
       LLB = CurLine
       FSB = CurSimb
       LSB = i + 1
     Else
       If i > 80 Then
         BegSimb = i - 78
         CurX = 80
       Else
         BegSimb = 1
         CurX = i + 1
       End If
     End If

   Case %CTRL_LEFT_key     'Go to word left (works with screen only)

     Do While Screen(CurY, CurX) <> 32
       Decr CurX
       If CurX < 1 Then Exit Select
     Loop
     Do While Screen(CurY, CurX) = 32
       Decr CurX
       If CurX < 1 Then Exit Select
     Loop

   Case %CTRL_RIGHT_key    'Go to word right (works with screen only)

     Do While Screen(CurY, CurX) <> 32
       Incr CurX
       If CurX > 80 Then Exit Select
     Loop
     Do While Screen(CurY, CurX) = 32
       Incr CurX
       If CurX > 80 Then Exit Select
     Loop

   Case %Left_key

     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed And ShiftFlag = 0 Then
       ShiftFlag = 1
       FLB = CurLine
       LLB = CurLine
       FSB = CurSimb
       LSB = CurSimb + 1
     Elseif ShiftPressed Then
       Decr FSB
       Decr CurX
     Else
       ShiftFlag = 0
       Decr CurX
       If CurX > 0 Or CurSimb = 1 Then Show = %FALSE
     End If

   Case %Right_key

     If BegSimb => %MaxLen - 80 Then Iterate Loop
     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed And ShiftFlag = 0 Then
       ShiftFlag = 1
       FLB = CurLine
       LLB = CurLine
       FSB = CurSimb
       LSB = CurSimb + 1
       If LSB > CurLen Then LSB = CurLen + 1
     Elseif ShiftPressed Then
       Incr LSB
       Incr CurX
       If LSB > CurLen Then LSB = CurLen + 1
     Else
       ShiftFlag = 0
       Incr CurX
       If CurX < 81 Then Show = %FALSE
     End If

   Case %Up_key                        'Line up

     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed And ShiftFlag = 0 Then
       ShiftFlag = 1
       FLB = CurLine
       LLB = CurLine
       FSB = 1
       LSB = %MaxLen
     Elseif ShiftPressed Then
       Decr FLB
       Decr CurY
     Else
       ShiftFlag = 0
       CanBeRestored = %FALSE
       Decr CurY
       If CurY > 0 Then Show = %FALSE
     End If

   Case %Down_key                      'Line down

     If CurLine => Nlines Then Iterate Loop
     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed And ShiftFlag = 0 Then
       ShiftFlag = 1
       FLB = CurLine
       LLB = CurLine
       FSB = 1
       LSB = %MaxLen
     Elseif ShiftPressed Then
       Incr LLB
       Incr CurY
     Else
       ShiftFlag = 0
       CanBeRestored = %FALSE
       Incr CurY
       If CurY < 24 Then Show = %FALSE
     End If

   Case %PgUp_key                      'Page up

     ShiftFlag = 0
     CanBeRestored = %FALSE
     Decr BegLine, %Lpage

   Case %PgDn_key                      'Page down

     ShiftFlag = 0
     CanBeRestored = %FALSE
     If CurLine => Nlines Then Iterate Loop
     Incr BegLine, %Lpage

   Case %CTRL_HOME_key                 'Go to top of screen

     ShiftFlag = 0
     CanBeRestored = %FALSE
     CurY = 1
     Show = %FALSE

   Case %CTRL_END_key                  'Go to bottom of screen

     ShiftFlag = 0
     CanBeRestored = %FALSE
     CurY = 24
     Show = %FALSE

   Case %CTRL_PG_UP_key                'Go to top of file

     ShiftFlag = 0
     CanBeRestored = %FALSE
     BegSimb = 1
     BegLine = 1
     CurX = 1
     CurY = 1

   Case %CTRL_PG_DOWN_key              'Go to bottom of file

     ShiftFlag = 0
     CanBeRestored = %FALSE
     BegSimb = 1
     BegLine = Nlines
     CurX = 1
     CurY = 1

   Case %DEL_key                       'Delete char right

     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed And BlockHere Then
       BlockSize = fBlockSize()
       CopyToClipBoard                 'Cut (to Clipboard)
       DeleteBlock
       HideBlock
       Exit Select
     End If

     If CurLen = 0 And CurSimb = 1 And CurLine = Nlines Then Exit Select
     ShiftFlag = 0
     IsChanged = %TRUE
     If BakLine = "" Then BakLine = T(CurLine)
     If CurSimb <= CurLen Then
       CanBeRestored = %TRUE
       DeleteChar
     Else
       s = Space$(CurSimb - CurLen - 1)
       If CurLen = 0 And CurSimb = 1 Then s = ""
       T(CurLine) = T(CurLine) + s + T(CurLine + 1)'Ltrim$(T(CurLine + 1))
       CanBeRestored = %FALSE
       DeleteChunk CurLine + 1, 1
       CorrectionDL
     End If

   Case %BcSp_key                      'N.B.!!! Does not delete a string!
                                       'To my mind it's better
     ShiftFlag = 0
     IsChanged = %TRUE
     If CurSimb = 1 Then Exit Select
     If BakLine = "" Then BakLine = T(CurLine)
     CanBeRestored = %TRUE
     If CurSimb > CurLen + 1 Then
       Decr CurX
     Else
       Decr CurSimb
       DeleteChar
       Decr CurX
     End If

   Case %CTRL_N_key                    'Insert empty line

     ShiftFlag = 0
     CanBeRestored = %FALSE
     If CurLine => Nlines Then Exit Select
     IsChanged = %TRUE
     InsertChunk CurLine - 1, 1
     CorrectionIL
     BegSimb = 1
     CurX = 1

   Case %CTRL_Y_key                    'Delete line

     ShiftFlag = 0
     CanBeRestored = %FALSE
     If CurLine => Nlines Then Exit Select
     IsChanged = %TRUE
     DeleteChunk CurLine, 1
     CorrectionDL
     BegSimb = 1
     CurX = 1

   Case %ENTER_key

     ShiftFlag = 0
     CanBeRestored = %FALSE
     If Ins = 1 Then
       IsChanged = %TRUE
       BreakLine
       If Indent = 1 Then
         T(CurLine + 1) = Space$(Indnt) + T(CurLine + 1)
         CurX = Indnt + 1
         If CurLine + 1 = FLB Then FSB = 1 'Sorry, I'm lazy ;-))
       Else
         CurX = 1
       End If
     Else
       CurX = 1
     End If
     If CurY < 24 Then
       Incr CurY
     End If
     BegSimb = 1

   Case %CTRL_K_key

     Select Case fMore()
     Case %CTRL_B_key, &H42, &H62      'Mark block begin

       ShiftFlag = 0
       FLB = CurLine
       FSB = CurSimb
       If CurLen = 0 Then FSB = 1
       BlockSize = fBlockSize()

     Case %CTRL_K_key, &H4B, &H6B      'Mark block end

       ShiftFlag = 0
       LLB = CurLine
       LSB = CurSimb
       If CurLen = 0 Then LSB = 1
       If LSB = 1 Then
         Decr LLB
         LSB = %MaxLen
       End If
       BlockSize = fBlockSize()

     Case %CTRL_N_key, &H4E, &H6E      'Mark line

       ShiftFlag = 0
       FLB = CurLine
       FSB = 1
       LLB = CurLine
       LSB = %MaxLen
       BlockSize = fBlockSize()

     Case %CTRL_T_key, &H54, &H74      'Mark word at cursor position

       ShiftFlag = 0
       s = T(CurLine)
       FSB = 0
       LSB = 0
       FLB = CurLine
       LLB = CurLine
       For i = CurSimb To 1 Step -1    'Find left bound of Word
         If Instr(Delimiters, Mid$(s, i, 1)) Then
           FSB = i + 1
           Exit For
         End If
       Next
       If FSB = 0 Then FSB = 1
       For i = CurSimb + 1 To Len(s)   'Find right bound of Word
         If Instr(Delimiters, Mid$(s, i, 1)) Then
           LSB = i
           Exit For
         End If
       Next
       If LSB = 0 Then LSB = Len(s) + 1
       BlockSize = fBlockSize()

     Case %CTRL_Y_key, &H55, &H75      'Delete block

       ShiftFlag = 0
       If BlockHere Then
         CanBeRestored = %FALSE
         DeleteBlock
         HideBlock
         IsChanged = %TRUE
       End If

     Case %CTRL_C_key, &H43, &H63      'Copy block

       ShiftFlag = 0
       CanBeRestored = %FALSE
       BlockSize = fBlockSize()
       MoveBlock 0                     '0 - copy

     Case %CTRL_V_key, &H56, &H76      'Move block

       ShiftFlag = 0
       CanBeRestored = %FALSE
       BlockSize = fBlockSize()
       MoveBlock 1                     '1 - move

     Case %CTRL_R_key, &H52, &H72      'Read block from disk (tricky!:)

       ShiftFlag = 0
       BlockFile = Ltrim$(fTinput("File name: ", BlockFile))
       If BlockFile = "" Then Exit Select

       If Dir$(BlockFile) = "" Then
         Message " File not found! " + "Press a key..."
         Exit Select
       End If

       IsChanged = %TRUE
       CanBeRestored = %FALSE

       Cprint 22, 25, " Working... ", %ErrAttr + %Blinking
       ClearStorage
       NS = 0
       Fi = Freefile
       Open BlockFile For Input As Fi
       Do While Not Eof(Fi)
         Line Input #Fi, T(%MaxLines - NS)   'Revers reading text array
         Incr NS
         If NS => (%MaxLines - Nlines) \ 2 Then
           Message " Out of memory! " + "Press a key..."
           Goto ErrorGate
         End If
       Loop
       Decr NS
       Close Fi
       FLS = %MaxLines - NS + 1
       FL = NS
       i = FLS
       k = %MaxLines
       Do
         Swap T(i), T(k)               'Get direct text array
         Incr i
         Decr k
         If i => k Then Exit Loop
       Loop
       BlockType = 2
       InsertFromStorage

     Case %CTRL_W_key, &H57, &H77      'Write block to disk

       ShiftFlag = 0
       If Not BlockHere Then Exit Select
       BlockFile = fTinput("File name: ", BlockFile)
       If BlockFile = "" Then Exit Select
       If Dir$(BlockFile) <> "" Then
         i = fAnswer(" Rewrite")
         If i = %NO Or i = %ABORT Then Exit Select
       End If
       Fi = Freefile
       Open BlockFile For Output As Fi
       If FLB = LLB Then
         Print #Fi, Mid$(T(LLB), FSB, LSB - FSB + 1)
       Else
         Print #Fi, Mid$(T(FLB), FSB)
         For i = FLB + 1 To LLB - 1
           Print #Fi, T(i)
         Next
         Print #Fi, Left$(T(LLB), LSB)
       End If
       Close Fi

     End Select

   Case %ALT_R_key                     'Ruler under current line

     ShiftFlag = 0
     If CurY < 23 Then
       Cprint 1, CurY + 1, Mid$(Ruler(1), BegSimb, 80), &H70
       Cprint 1, CurY + 2, Mid$(Ruler(2), BegSimb, 80), &H70
       Simb = fGetKey()
     End If

   Case %F02_key                       'Save edit file, not quit

     ShiftFlag = 0
     SaveEditFile
     IsChanged = %FALSE

   Case %F10_key                       'Quit, no save

     ShiftFlag = 0
     If IsChanged Then
       If fAnswer(" Are you sure ") = %YES Then
         Exit Loop
       End If
     End If

   Case %F12_key                       'Indent toggle ON/OFF

     ShiftFlag = 0
     Indent = Indent Xor 1

   Case %CTRL_Q_key

     ShiftFlag = 0
     Select Case fMore()
     Case %CTRL_Y_key, &H59, &H79      'Delete to end if line

       IsChanged = %TRUE
       If BakLine = "" Then BakLine = T(CurLine)
       CanBeRestored = %TRUE
       Do While CurSimb <= CurLen
         DeleteChar
         Decr CurLen
       Loop

     Case %CTRL_B_key, &H42, &H62      'Find block begin

       ShiftFlag = 0
       If Not BlockHere Then Exit Select
       CanBeRestored = %FALSE
       CurX = 1
       CurY = 1
       BegSimb = 1
       BegLine = FLB

     Case %CTRL_K_key, &H4B, &H6B      'Find block end

       ShiftFlag = 0
       If Not BlockHere Then Exit Select
       CanBeRestored = %FALSE
       CurX = 1
       CurY = 1
       BegSimb = 1
       BegLine = LLB

     Case %CTRL_L_key, &H4C, &H6C      'Restore Line

       ShiftFlag = 0
       If CanBeRestored Then T(CurLine) = BakLine

     Case %CTRL_F_key, &H46, &H66      'Find string

       ShiftFlag = 0
       Find = fTinput("Find:", Find)
       If Find = "" Then Exit Select
       Options = fDosUcase(Ltrim$(Rtrim$(fTinput("Options:", Options))))
       If Options = "" Then Options = "U" 'Let it'll be default

       FindSearchBounds
       SearchMe

     Case %CTRL_A_key, &H41, &H61      'Find and replace

       ShiftFlag = 0
       Find = fTinput("Find:", Find)
       If Find = "" Then Exit Select
       ReplaceWith = fTinput("Replace with:", ReplaceWith) '"" - possible!
       Options = fDosUcase(Ltrim$(Rtrim$(fTinput("Options:", Options))))
       If Options = "" Then Exit Select

       FindSearchBounds

       If Not NeedPermission Then
         Cprint 22, 25, " Working... ", %ErrAttr + %Blinking
       End If
       Counter = 0                     'Counter of replacements
       If GlobalSearch Then            'Global search
         For i = 1 To Nlines
           FindAndReplace i
         Next
       Elseif LocalSearch Then         'Local search (inside of block)
         For i = FLB To LLB
           FindAndReplace i
         Next
       End If
       ShowPage
       If Counter <> 0 Then IsChanged = %TRUE
       Message Str$(Counter) + " changes are made. " + "Press a key..."
       Counter = 0

     End Select

   Case %CTRL_L_key                    'Next search

     ShiftFlag = 0
     SFL = CurLine
     SFS = CurSimb + LenFind
     SearchMe

   Case %INS_key

     ShiftPressed = ((@ShiftByte AND 3) <> 0)
     If ShiftPressed Then              'Paste (from Clipboard)
       InsertFromClipBoard
       IsChanged = %TRUE
       Exit Select
     End If
     Ins = Ins Xor 1                   'INS ON/OFF

   Case %CTRL_INS_key                  'Copy  (to Clipboard)

     ShiftFlag = 0
     If Not BlockHere Then Exit Select
     BlockSize = fBlockSize()
     CopyToClipBoard

   Case %ALT_C_key                     'Show Clipboard

     ShiftFlag = 0
     s = Space$(80)
     Mid$(s, 27) = "Clipboard: (" + Str$(NC) + " lines)."
     Cprint 1, 1, s, %ErrAttr
     For i = 1 To Min(23, NC)
       s = Space$(80)
       Mid$(s, 1) = Clip(i)
       Cprint 1, i + 1, s, %ClipAttr
     Next
     Locate ,, 0
     Simb = fGetKey()

   Case %ALT_X_key, %ESC_key           'Exit editor

     ShiftFlag = 0
     If IsChanged Then
       k = fAnswer(" Save")
       If k = %YES Then
         SaveEditFile
         Exit Loop
       Elseif k = %NO Then
         Exit Loop
       Elseif k = %ABORT Then
         Exit Select
       End If
     Else
       Exit Loop
     End If

   Case %DelimLine                     'Inserts delimiter line

     ShiftFlag = 0
     CanBeRestored = %FALSE
     InsertChunk CurLine - 1, 1
     CorrectionIL
     T(CurLine) = Chr$(39) + String$(75, 45)
     IsChanged = %TRUE

   Case %TAB_key                       'I do not like TABS, so simulate them

     ShiftFlag = 0
     CanBeRestored = %TRUE
     If BakLine = "" Then BakLine = T(CurLine)
     For i = 0 To %TabSize - 1         '"For" - to avoid corrections
       InsertChar CurLine, CurSimb, Chr$(32)
       Incr CurSimb
     Next
     Incr CurX, %TabSize

   Case Else                           'All ather chars

     ShiftFlag = 0
     If 31 < Simb And Simb < 256 Then
       If BakLine = "" Then BakLine = T(CurLine)
       CanBeRestored = %TRUE
       IsChanged = %TRUE
       T(CurLine) = T(CurLine) + Space$(%MaxLen)
       If Ins = 1 Then
         InsertChar CurLine, CurSimb, Chr$(Simb)
       Else
         Mid$(T(CurLine), CurSimb) = Chr$(Simb)
       End If
       Incr CurX
       If CurX = 81 Then
         Incr BegSimb
         CurX = 80
       End If
     End If

   End Select

   If FLB < LLB Or (FLB = LLB And FSB < LSB) Then
     BlockHere = %TRUE
     FindBlockType
   Else
     BlockHere = %FALSE
     BlockType = 0
     BlockSize = 0
   End If

   If Not CanBeRestored Then BakLine = ""

 Loop

 If PickFile <> "" Then                'Write info to pick file
   Fi = Freefile
   Open PickFile For Binary As Fi
   Put Fi ,, BegSimb
   Put Fi ,, BegLine
   Put Fi ,, CurX
   Put Fi ,, CurY
   Put Fi ,, FSB
   Put Fi ,, FLB
   Put Fi ,, LSB
   Put Fi ,, LLB
   Put Fi ,, BlockHere
   Put Fi ,, FileSize
   Close Fi
 End If

 Color 7, 0
 Cls
 SetNormCursor
 Locate ,,,10, 12
 End

'---------------------------------------------------------------------------
 Sub ShowPage()

   Dim i As Integer
   Dim n As Integer
   Dim s As String
   Dim sa As String
   Dim Attr As Integer
   Dim Ln As String
   Dim Sn As String
   Dim Co As String
   Dim Uc As String
   Dim Tl As String

   If     CurX < 1 Then
     Decr BegSimb
     CurX = 1
   Elseif CurX > 80 Then
     Incr BegSimb
     CurX = 80
   End If

   If     CurY < 1 Then
     Decr BegLine
     CurY = 1
   Elseif CurY > 23 Then
     Incr BegLine
     CurY = 23
   End If

   If BegLine < 1 Then BegLine = 1
   If BegLine > Nlines Then BegLine = Nlines

   If BegSimb < 1 Then BegSimb = 1
   If BegSimb > %MaxLen Then BegSimb = %MaxLen

   CurLine = BegLine + CurY - 1
   CurSimb = BegSimb + CurX - 1

   If Show Then
     For i = 1 To 24
       s = Space$(80)
       n = BegLine + i - 1
       If n <= Nlines Then
         Mid$(s, 1) = Mid$(T(n), BegSimb)
       End If
       Locate i, 1, 0
       If BlockHere And FLB < n And n < LLB Then
         Color Bt, Ba
         Print s;
       Else
         Color Nt, Na
         Print s;
         ColorLine i
       End If
     Next
   End If
   Show = %TRUE

   If IsChanged Then
     Uc = "#"           'changed
   Else
     Uc = "="           'unchanged
   End If

   Ln = Right$("000" + Ltrim$(Str$(CurLine)), 4)            'Line number
   Sn = Right$("000" + Ltrim$(Str$(CurSimb)), 3)            'Simbol number,
   Co = Right$("000" + Ltrim$(Str$(Screen(CurY, CurX))), 3) 'and its ASC
   Tl = Right$("000" + Ltrim$(Str$(NLines - 1)), 4)         'Total lines

   Cprint  1, 25, "<" + Ln + ":" + Sn + ":" + Co + ">" + Uc + Tl , %DownLineAttr
   Cprint 22, 25, FileName, %DownLineAttr

   If BlockHere Then Attr = %DownLineAttr Else Attr = %HideAttr
   Cprint 69, 25, "BLOCK", Attr

   If Ins = 1 Then
     Locate ,,, 4, 12                  '"Big" cursor
     Attr = %DownLineAttr
   Else
     Locate ,,, 10, 12                 '"Usual" cursor
     Attr = %HideAttr
   End If
   Cprint 76, 25, "INS", Attr

   If Indent = 1 Then  Attr = %DownLineAttr Else Attr = %HideAttr
   Cprint 80, 25, "I", Attr

   Locate CurY, CurX, 1                'Make cursor visible

 End Sub
'---------------------------------------------------------------------------
 Sub SaveEditFile()

   Dim i As Integer
   Dim Fi As Integer
   Dim BakFile As String

   Cprint 22, 25, " Saving... ", %ErrAttr + %Blinking
   i = Instr(FileName, ".")
   If i Then
     BakFile = Left$(FileName, i) + "BAK"
   Else
     BakFile = FileName + "." + "BAK"
   End If

   If Dir$(BakFile) <> "" Then
     Kill BakFile
   End If

   If BakFile <> FileName Then Name FileName As BakFile

   Fi = Freefile
   Open FileName For Output As Fi
   For i = 1 To Nlines
     Print #Fi, Rtrim$(T(i))
   Next
   Close Fi
   Cprint 22, 25, Space$(11), %DownLineAttr

 End Sub
'---------------------------------------------------------------------------
 Sub InsertChar(LineN As Integer, SimbN As Integer, Simb As String)

   Dim s As String
   If Len(T(LineN)) < SimbN Then
     T(LineN) = T(LineN) + Space$(SimbN - Len(T(LineN)))
   End If
   s = T(LineN)
   T(LineN) = Left$(s, SimbN - 1) + Simb + Right$(s, Len(s) - SimbN + 1)

   CorrectBounds +1

   If LSB > %MaxLen Then LSB = %MaxLen

 End Sub
'---------------------------------------------------------------------------
 Sub DeleteChar()

   Dim s As String
   s = T(CurLine)
   If s = "" Then Exit Sub
   T(CurLine) = Left$(s, CurSimb - 1) + Right$(s, Len(s) - CurSimb)

   CorrectBounds -1

   If LSB = 255 Then LSB = %MaxLen

 End Sub
'---------------------------------------------------------------------------
 Sub CorrectBounds(Delta As Integer)

   If BlockHere Then
     If CurLine = FLB And CurLine = LLB Then' One line block
       If CurSimb < FSB Then
         FSB = FSB + Delta
         LSB = LSB + Delta
       Elseif CurSimb < LSB then
         LSB = LSB + Delta
       End If
     Elseif CurLine = FLB Then         'First line of block
       If CurSimb < FSB Then
         FSB = FSB + Delta
       End If
     Elseif CurLine = LLB Then         'Last line of block
       If CurSimb < LSB Then
         LSB = LSB + Delta
       End If
     End If
   End If

 End Sub
'---------------------------------------------------------------------------
 Sub BreakLine()

   Dim a As String
   Dim b As String
   If BlockHere Then
     If CurLine = FLB And CurLine = LLB Then
       If CurSimb <= FSB Then
         FSB = FSB - CurSimb + 1
         LSB = LSB - CurSimb + 1
       End If
     Elseif CurLine = FLB Then
       If CurSimb <= FSB Then
         FSB = FSB - CurSimb + 1
       End If
     Elseif CurLine = LLB Then
       If CurSimb <= LSB Then
         LSB = LSB - CurSimb + 1
       End If
     End If
   End If

   TestLine

   a = Mid$(T(CurLine), 1, CurSimb - 1)
   b = Mid$(T(CurLine), CurSimb)
   InsertChunk CurLine, 1
   CorrectionIL
   T(CurLine) = a
   T(CurLine + 1) = b

 End Sub
'-------------------------------------------------------------------------
 Sub InsertChunk(L As Integer, N As Integer)
'
'  Inserts N empty lines after L-th line.
'  "SWAP" works faster then strings assignment!
'
   Dim i As Integer

   If N < 1 Then Exit Sub
   If Nlines + N * 2 => %MaxLines Or Fre(-1) < BlockSize Then
     Message " Out of memory! " + "Press a key..."
     Goto ErrorGate
   End If

   For i = Nlines + N To L + N + 1 Step -1    '?????? check it! (dubious)
     Swap T(i - N), T(i)               'All lines after Nlines are empty
   Next
   Incr Nlines, N


 End Sub
'-------------------------------------------------------------------------
 Sub DeleteChunk(L As Integer, N As Integer)
'
'  Deletes N lines after L-th line.
'
   Dim i As Integer
   If N < 1 Then Exit Sub
   For i = L To Nlines
     T(i) = T(i + N)
   Next
   Decr Nlines, N

 End Sub
'-------------------------------------------------------------------------
 Sub CorrectionIL()
'Block bounds corrections after "Insert Line"

   If BlockHere Then
     If CurLine <= FLB Then            'Line before block
       Incr FLB
       Incr LLB
     Elseif CurLine <= LLB Then
       Incr LLB
     End If
   End If

 End Sub
'-------------------------------------------------------------------------
 Sub CorrectionDL()
'Block bounds corrections after "Delete Line"

   If BlockHere Then
     If CurLine < FLB Then             'Line before block
       Decr FLB
       Decr LLB
     Elseif CurLine <= LLB Then        'Line inside of block
       Decr LLB
       If CurLine = FLB And CurLine = LLB Then 'One line block
         LSB = %MaxLen
       End If
     End If
   End If

 End Sub
'-------------------------------------------------------------------------
 Sub ColorLine(n As Integer)           'n - line number

   Dim NL As Integer
   Dim Lbnd As Integer                 'Left bound
   Dim Rbnd As Integer                 'Right bound

   NL = BegLine + n - 1
   If NL < FLB Or NL > LLB Then
     Exit Sub                          'Out of block
   End If
   If NL > FLB And NL < LLB Then       'Whole line inside of block
     Lbnd = 1
     Rbnd = 80
   Elseif NL = FLB And NL = LLB Then   'Whole block inside of line
     Lbnd = FSB - BegSimb + 1
     Rbnd = LSB - BegSimb
   Elseif NL = FLB Then                'It's first line of block
     Lbnd = FSB - BegSimb + 1
     Rbnd = 80
   Elseif NL = LLB Then                'It's last line of block
     Lbnd = 1
     Rbnd = LSB - BegSimb
   End If
   If Lbnd < 1 Then Lbnd = 1           'Make corrections
   If Rbnd < 1 Or Lbnd > 80 Then Exit Sub
   If Rbnd > 80 Then Rbnd = 80
   ReColor Lbnd, n, Rbnd - Lbnd + 1, %BlockAttr

 End Sub
'---------------------------------------------------------------------------
 Function fGetKey() Public As Integer

   Dim G As String
   While Instat : G = Inkey$ : Wend    'Clear keyboard buffer
   Do
     G = Inkey$
   Loop Until G <> ""
   G = G + Chr$(0)
   Function = Cvi(G)

 End Function
'---------------------------------------------------------------------------
 Sub SetFastCursor()

   ! Mov ax, &H0305
   ! Mov bx, &H0000
   ! Int &H16

 End Sub
'----------------------------------------------------------------------------
 Sub SetNormCursor()

   ! Mov ax, &H0305
   ! Mov bx, &H0105
   ! Int &H16

 End Sub
'---------------------------------------------------------------------------
 Sub ReColor(x As Integer, y As Integer, n As Integer, Attr As Word)

   Dim Sptr As Byte Ptr
   Dim i As Integer
   Sptr = Pbvscrnbuff + (y - 1) * 160 + (x - 1) * 2 + 1
   For i = 1 To n
     @Sptr = Attr
     Incr Sptr, 2
   Next

 End Sub
'---------------------------------------------------------------------------
 Sub Cprint(xb As Integer, yb As Integer, s As String, Attr As Integer)

   Dim TextPtr AS Byte Ptr
   Dim ScrPtr AS Byte Ptr
   Dim i As Integer

   ScrPtr = pbvScrnBuff + (yb - 1) * 160 + (xb - 1) * 2
   TextPtr = Strptr32(s)
   For i=1 To Len(s)
     @ScrPtr = @TextPtr
     Incr TextPtr
     Incr ScrPtr
     @ScrPtr = Attr
     Incr ScrPtr
   Next

 End Sub
'---------------------------------------------------------------------------
 Function fMore() As Integer

   Cprint 22, 25, "^K more!", %ErrAttr + %Blinking
   Function = fGetKey()
   Cprint 22, 25, Space$(10), %DownLineAttr

 End Function
'---------------------------------------------------------------------------
  Sub HideBlock()

    FLB = 1
    LLB = 1
    FSB = 1
    LSB = 1

  End Sub
'---------------------------------------------------------------------------
 Sub DeleteBlock()

   If BlockHere Then

     Select Case BlockType
     Case 1
       T(FLB) = Left$(T(FLB), FSB - 1) + Mid$(T(FLB), LSB)
     Case 2
       DeleteChunk FLB, FL
     Case 3
       T(FLB) = Left$(T(FLB), FSB - 1) + T(LLB + 1)
       DeleteChunk FLB + 1, FL + 1
     Case 4
       T(LLB) = Mid$(T(LLB), LSB)
       DeleteChunk FLB, FL
     Case 5
       T(FLB) = Left$(T(FLB), FSB - 1) + Mid$(T(LLB), LSB)
       DeleteChunk FLB + 1, FL + 1
     End Select
     If CurLine > LLB Then BegLine = BegLine - FL

   End If

 End Sub
'---------------------------------------------------------------------------
 Sub MoveBlock(F As Integer)           'F=0 - copy, F=1 - move

   Dim i As Integer
   Dim n As Integer
   Dim m As Integer

   If BlockHere Then
'
'    Can not copy/move block into itself
'
     If CurLine > FLB And CurLine <= LLB Then
       If FLB = LLB Then
         If FSB <= CurSimb And CurSimb < LSB Then Exit Sub
       Elseif CurLine = FLB Then
         If CurSimb => FSB Then Exit Sub
       Elseif CurLine = LLB Then
         If CurSimb < LSB Then Exit Sub
       Else
         Exit Sub
       End If
     End If

     IsChanged = %TRUE
     CopyBlockToStorage

     If F = 1 Then                     'If move

       n = Nlines
       m = CurLen
       DeleteBlock
       n = Nlines - n
       If CurLine > LLB Then
         Incr BegLine, n
         Incr CurLine, n
         Incr FLB, n
         Incr LLB, n
       Elseif CurLine = LLB Then
         m =  m - Len(T(LLB))
         If CurSimb > LSB Then
           Decr CurSimb, m
         End If
       End If

       TestLine

     End If

     InsertFromStorage

   End If

 End Sub
'---------------------------------------------------------------------------
 Sub ClearClipboard()

   Redim Clip(%Nclip)
   NC = 0

 End Sub
'---------------------------------------------------------------------------
 Sub CopyToClipboard()

   Dim i As Integer
   ClearClipboard
   For i = 1 To LLB - FLB + 1
     If i > %Nclip Then Exit For
     Clip(i) = T(FLB + i - 1)
   Next
   NC = i - 1

 End Sub
'---------------------------------------------------------------------------
 Sub InsertFromClipboard()

   Dim i As Integer
   ClearStorage
   HideBlock

   If CurSimb = 1 Then
     InsertChunk CurLine - 1, NC
     For i = 1 To NC
       T(CurLine + i - 1) = Clip(i)
     Next
   Else
     BreakLine
     InsertChunk CurLine, NC - 1
     T(CurLine) = T(CurLine) + Clip(1)
     For i = 2 To NC
       T(CurLine + i - 1) = Clip(i)
     Next
   End If
   FSB = CurSimb
   FLB = CurLine
   LSB = %MaxLen
   LLB = CurLine + NC - 1
   FindBlockType
   BegSimb = 1
   CurSimb = 1

 End Sub
'---------------------------------------------------------------------------
 Sub ClearStorage()

   Dim i As Integer
   For i = FLS To %MaxLines
     T(i) = ""
   Next
   NS = 0                              'Number of Storage lines

 End Sub
'---------------------------------------------------------------------------
 Sub CopyBlockToStorage()

   Dim i As Integer
   Dim n As Integer

   If Nlines + (LLB - FLB + 1) * 2 => %MaxLines Or Fre(-1) < BlockSize Then
     Message " Out of memory! " + "Press a key..."
     Goto ErrorGate
   End If
   FindBlockType
   n = LLB - FLB + 1
   ClearStorage

   FLS = %MaxLines - n                 'First line of storage

   If FLB = LLB Then
     T(FLS) = Mid$(T(FLB), FSB, LSB - FSB)
     Incr NS
   Else
     T(FLS) = Mid$(T(FLB), FSB)
     Incr NS
     For i = 2 To n - 1
       T(FLS + i - 1) = T(FLB + i - 1)
       Incr NS
     Next
     T(FLS + n - 1) = Mid$(T(LLB), 1, LSB - 1)
     Incr NS
   End If

   FL = NS                             'Full lines
   If FSB > 1 Then Decr FL
   If LSB < %MaxLen Then Decr FL
   If FL < 0 Then FL = 0

 End Sub
'---------------------------------------------------------------------------
 Sub InsertFromStorage()

   Dim i As Integer
   Dim n As Integer
   Dim sa As String
   Dim sb As String

   If NS = 0 Then Exit Sub             'If Storage is empty

   Cprint 22, 25, " Working... ", %ErrAttr + %Blinking

   TestLine

   If CurSimb = 1 Then
     sa = ""
   Else
     sa = Left$(T(CurLine), CurSimb - 1)
   End If
   sb = Mid$(T(CurLine), CurSimb)

   Select Case BlockType
   Case 1
     T(CurLine) = sa + T(FLS) + sb
     LSB = CurSimb + Len(T(FLS))
     LLB = CurLine
   Case 2
     If CurSimb = 1 Then
       InsertChunk CurLine - 1, FL
       For i = 1 To FL
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
     Else
       BreakLine
       InsertChunk CurLine, FL - 1
       T(CurLine) = T(CurLine) + T(FLS)
       For i = 2 To NS
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
       FSB = CurSimb
     End If
     LSB = %MaxLen
     LLB = CurLine + NS - 1
   Case  3
     If CurSimb = 1 Then
       InsertChunk CurLine - 1, FL + 1
       For i = 1 To FL + 1
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
     Else
       BreakLine
       InsertChunk CurLine, FL
       T(CurLine) = T(CurLine) + T(FLS)
       For i = 2 To NS
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
     End If
     LLB = CurLine + NS - 1
   Case 4
     If CurSimb = 1 Then
       InsertChunk CurLine - 1, FL
       For i = 1 To FL
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
       T(CurLine + FL) = T(FLS + NS - 1) + sb
     Else
       T(CurLine) = Left$(T(CurLine), CurSimb - 1)
       InsertChunk CurLine, FL
       T(CurLine) = T(CurLine) + T(FLS)
       For i = 2 To FL 'NS
         T(CurLine + i - 1) = T(FLS + i - 1)
       Next
       T(CurLine + FL) = T(FLS + NS - 1) + sb
     End If
     LLB = CurLine + NS - 1
   Case 5
     If CurSimb = 1 Then
       InsertChunk CurLine - 1, FL + 1
       T(CurLine) = T(FLS)
       For i = 1 To FL
         T(CurLine + i) = T(FLS + i)
       Next
       T(CurLine + NS - 1) = T(FLS + NS - 1) + sb
     Else
       BreakLine
       InsertChunk CurLine, FL
       T(CurLine) = T(CurLine) + T(FLS)
       For i = 1 To FL
         T(CurLine + i) = T(FLS + i)
       Next
       T(CurLine + NS - 1) = T(FLS + NS - 1) + sb
     End If
     LLB = CurLine + NS - 1
   End Select
   FSB = CurSimb
   FLB = CurLine

   Cprint 22, 25, Space$(12), %DownLineAttr

 End Sub
'---------------------------------------------------------------------------
 Sub Message(Mess As String)

   Dim k As Integer
   Cprint 22, 25, Mess, %ErrAttr
   Sound 440, .5
   k = fGetKey()
   Cprint 22, 25, Space$(Len(Mess)), %DownLineAttr

 End Sub
'---------------------------------------------------------------------------
 Sub SearchMe()

   Dim m As Integer
   Dim i As Integer
   Dim k As Integer
   Dim s As String
   Dim t As String

   m = SFL                             'Search from line
   t = Find
   If AnyCase Then t = fDosUcase(t)
   For i = m To STL                    'Search to line
     s = T(i)
     If AnyCase Then s = fDosUcase(s)
     Do
       k = Instr(SFS, s, t)
       If k = 0 Then Exit Loop
       If WholeWords Then              'If whole words only
         If Not fWord(s, k) Then
           Incr SFS, LenFind
           Iterate Loop
         Else
           SFS = k + LenFind
         End If
       Else
         Incr SFS
       End If
       BegLine = i
       BegSimb = k
       If k < 81 Then
         BegSimb = 1
         CurX = k
       Else
         CurX = 1
       End If
       CurY = 1
       Exit Sub
     Loop
     SFS = 1
   Next
   If k = 0 Then Message " Not found! "

 End Sub
'---------------------------------------------------------------------------
 Function fAnswer(Prompt As String) As Integer

   Dim m As Integer
   Dim s As String
   s = Prompt + "? (Y/N/ESC) "
   Cprint 22,25, s, %ErrAttr + %Blinking
   m = fGetkey() And &HFF
   Cprint 22,25, Space$(Len(Prompt) + 12), %DownLineAttr
   If Instr("Yy", Chr$(m)) Then
     Function = %YES
   Elseif Instr("Nn", Chr$(m)) Then
     Function = %NO
   Else
     Function = %ABORT
   End If

 End Function
'---------------------------------------------------------------------------
 Sub FindAndReplace(n As Integer)      'Find and replace in n-th line

   Dim sa as String
   Dim sb As String
   Dim i As Integer
   Dim Ans As Integer

   If AnyCase Then
     sb = fDosUcase(Find)
   Else
     sb = Find
   End If

   Do

     If AnyCase Then
       sa = fDosUcase(T(n))
     Else
       sa = T(n)
     End If

     i = Instr(SFS,sa, sb)
     If i = 0 Then Exit Loop

     SFS = i

     If WholeWords Then                'If whole words only
       If Not fWord(sa, i) Then
         Incr SFS, LenFind
         Iterate Loop
       End If
     End If

     CurSimb = i
     CurLine = n

     BegSimb = i
     BegLine = n

     If BegSimb < 81 Then
       BegSimb = 1
       CurX = i
     Else
       CurX = 1
     End If
     CurY = 1

     If NeedPermission Then
       ShowPage
       Ans = fAnswer(" Replace")
       If Ans = %ABORT Then Goto ErrorGate
     Else
       Ans = %YES
     End If

     If Ans = %YES Then
       T(CurLine) = Left$(T(CurLine), CurSimb - 1) _
                  + ReplaceWith _
                  + Mid$(T(CurLine), CurSimb + LenFind)
       Incr Counter
       Incr SFS, LenReplace
     Else
       Incr SFS, LenFind
     End If

     If n = STL And SFS > STS Then Exit Loop

   Loop
   SFS = 1

 End Sub
'---------------------------------------------------------------------------
 Function fTinput(Prompt As String, Edit As String) As String
'
'  Tiny input for the editor...
'
   Dim k As Integer
   Dim Ptr As Integer
   Dim x As Integer
   Dim y As Integer
   Dim n As Integer
   Dim ox As Integer
   Dim oy As Integer

   ox = Pos(0)
   oy = Csrlin
   x = 22 + Len(Prompt)
   y = 25
   n = 46 - Len(Prompt)
   Color 15, Ba
   Locate y, x
   Print Space$(n);
   Locate y, 22
   Print Prompt;
   Locate y, x,, 11, 12
   Do

     Ptr = Len(Edit)
     If Ptr > n Then
       Edit = Left$(Edit, n)
       Ptr = Len(Edit)
     End If
     Locate y, x
     Print Edit + " ";
     Locate y, x + Ptr

     k = fGetKey()

     Select Case k

     Case %ESC_key
       Edit = ""
       Exit Loop
     Case %DEL_key                     'Use it to delete whole edit string
       Locate y, x
       Print Space$(n);
       Edit = ""
     Case %ENTER_key
       Exit Loop
     Case %LEFT_key, %BCSP_key
       If Ptr > 0 Then
         Edit = Mid$(Edit, 1, Ptr - 1)
       Else
         Edit = ""
       End If
     Case 31 To 255
       Edit = Edit + Chr$(k)
     End Select
   Loop
   Cprint 22, y, Space$(47), %DownLineAttr
   Locate oy, ox
   Function = Edit

 End Function
'---------------------------------------------------------------------------
 Function fWord(s As String, Ns As Integer) As Integer
'
'  Returns TRUE if chunk at 'Ns' position of 's' is whole word
'
   Dim a As Integer
   Dim b As Integer

   If Ns = 1 And Ns + LenFind => Len(s) Then
     Function = %TRUE
     Exit Function
   Elseif Ns = 1 Then
     a = %TRUE
     b = (Instr(Delimiters, Mid$(s, Ns + LenFind, 1)) <> 0)
   Elseif Ns + LenFind => Len(s) Then
     a = (Instr(Delimiters, Mid$(s,       Ns - 1, 1)) <> 0)
     b = %TRUE
   Else
     a = (Instr(Delimiters, Mid$(s, Ns -       1, 1)) <> 0)
     b = (Instr(Delimiters, Mid$(s, Ns + LenFind, 1)) <> 0)
   End If

   Function = a And b

 End Function
'---------------------------------------------------------------------------
 Sub FindSearchBounds()

   GlobalSearch = (Instr(Options, "G") <> 0)
   LocalSearch = (Instr(Options, "L") <> 0)
   NeedPermission = (Instr(Options, "N") = 0)
   AnyCase = (Instr(Options, "U") <> 0)
   WholeWords = (Instr(Options, "W") <> 0)

   LenFind = Len(Find)
   LenReplace = Len(ReplaceWith)

   If LocalSearch Then
     SFL = FLB                           'Search from line
     STL = LLB                           'Search to line
     SFS = FSB                           'Search from simbol
     STS = LSB - 1                       'Search to simbol
   Elseif GlobalSearch Then
     SFL = CurLine                       ''?''1
     STL = Nlines
     SFS = 1
     STS = %MaxLen
   Else
     SFL = CurLine
     STL = Nlines
     SFS = CurSimb
     STS = %MaxLen
   End If

 End Sub
'---------------------------------------------------------------------------
 Function fDosUcase(Byval Text As String) As String
'
'  Supports international languages
'
   Reg %AX, &H6521
   Reg %DS, Strseg(Text)
   Reg %DX, Strptr(Text)
   Reg %CX, Len(Text)
   Call Interrupt &H21
   Function = Text

 End Function
'---------------------------------------------------------------------------
 Sub FindBlockType()

   If   FLB = LLB And LSB < %MaxLen Then'Block inside of line
     BlockType = 1
   Elseif FSB = 1 And LSB = %MaxLen Then'Full lines block
     BlockType = 2
   Elseif FSB > 1 And LSB = %MaxLen Then'Not full first line
     BlockType = 3
   Elseif FSB = 1 And LSB < %MaxLen Then'Not full last line
     BlockType = 4
   Elseif FSB > 1 And LSB < %MaxLen Then'Not full first and last lines
     BlockType = 5
   End If

   FL = LLB - FLB + 1                   'Calculate number of full lines
   If FSB > 1 Then Decr FL
   If LSB < %MaxLen Then Decr FL
   If FL < 0 Then FL = 0

 End Sub
'---------------------------------------------------------------------------
 Function fBlockSize() As Long

   Dim i As Integer
   Dim L As Long
   L = 0
   If BlockHere Then
     For i = FLB To LLB
       Incr L, Len(T(i))
     Next
   End If
   Function = L

 End Function
'---------------------------------------------------------------------------
 Sub TestLine()

   If CurSimb > CurLen Then
     T(CurLine) = T(CurLine) + Space$(CurSimb - Len(CurLine) + 1)
   End If

 End Sub
'---------------------------------------------------------------------------
' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\ END OF FILE ///////////////////////////////