'=========================================================================== ' 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) = ",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 " 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 ///////////////////////////////