From 07c60e460ed5b1be5beed4eaee420ddad894460f Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Wed, 25 May 2011 17:35:52 +0000 Subject: [PATCH] 2011-05-25 19:35 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + contrib/xhb/xhbtedit.prg * contrib/xhb/xhb.hbp * contrib/xhb/xhb.hbx + borrowed complete extended TEDITOR() class from xhb. The code looks very unclean and not Clipper compatible, so it will be part of xhb. Contains fixes to make it compile under vanilla Harbour with (default) high warning level. Plus some more basic code cleanups. Class was renamed to XHBEDITOR. --- harbour/ChangeLog | 10 + harbour/contrib/xhb/xhb.hbp | 1 + harbour/contrib/xhb/xhb.hbx | 1 + harbour/contrib/xhb/xhbtedit.prg | 3119 ++++++++++++++++++++++++++++++ 4 files changed, 3131 insertions(+) create mode 100644 harbour/contrib/xhb/xhbtedit.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ad15960b2a..3dd4e13b58 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -16,6 +16,16 @@ The license applies to all entries newer than 2009-04-28. */ +2011-05-25 19:35 UTC+0200 Viktor Szakats (harbour.01 syenar.hu) + + contrib/xhb/xhbtedit.prg + * contrib/xhb/xhb.hbp + * contrib/xhb/xhb.hbx + + borrowed complete extended TEDITOR() class from xhb. The code + looks very unclean and not Clipper compatible, so it will be + part of xhb. Contains fixes to make it compile under vanilla + Harbour with (default) high warning level. Plus some more + basic code cleanups. Class was renamed to XHBEDITOR. + 2011-05-25 15:18 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/ChangeLog ! removed repeated entry diff --git a/harbour/contrib/xhb/xhb.hbp b/harbour/contrib/xhb/xhb.hbp index 2649b78e8e..9c32aeee9b 100644 --- a/harbour/contrib/xhb/xhb.hbp +++ b/harbour/contrib/xhb/xhb.hbp @@ -101,6 +101,7 @@ xhberr.prg xhbfunp.prg xhbinkey.prg xhbmt.prg +xhbtedit.prg xhbver.prg xthrow.prg xhw32prn.prg diff --git a/harbour/contrib/xhb/xhb.hbx b/harbour/contrib/xhb/xhb.hbx index f85913ae8d..5d14d65c60 100644 --- a/harbour/contrib/xhb/xhb.hbx +++ b/harbour/contrib/xhb/xhb.hbx @@ -405,6 +405,7 @@ DYNAMIC WAITFORTHREADS DYNAMIC WILDMATCH DYNAMIC WIN32BMP DYNAMIC WIN32PRN +DYNAMIC XHBEDITOR DYNAMIC XHB_ADEL DYNAMIC XHB_AINS DYNAMIC XHB_ALLTRIM diff --git a/harbour/contrib/xhb/xhbtedit.prg b/harbour/contrib/xhb/xhbtedit.prg new file mode 100644 index 0000000000..8ef836807b --- /dev/null +++ b/harbour/contrib/xhb/xhbtedit.prg @@ -0,0 +1,3119 @@ +/* + * $Id$ + */ + +/* $Id$ + * Harbour Project source code: + * Editor Class (base for Memoedit(), debugger, etc.) + * + * Copyright 2000 Maurilio Longo + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries with other + * files to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +/* + * Pritpal Bedi + * 28Feb2004 + * + * Suppor for Clipper's MemoEdit( ..., nTextBufferRow, nTextBufferCol, nWindowRow, nWindowCol ) + * Rearrangement of code in logical sections. + * Reformatting of code to be more readable. + * Navigation code broken into small methods for easy mainainability on lines with TBrowse() + * + */ + +/* + * + * Teditor Fix: teditorx.prg -- V 3.0beta 2004/04/17 + * Copyright 2004 Giancarlo Niccolai + * + * Minimal revision for proper working (expecially with word warping). + * Fixed many funtions + * Added GotoCol() and GotoPos() to goto a logical column or position; + * they translate this movement in a adequate ::SetPos call. + * + * Modifications are based upon the following source file: + */ + +/* + * Teditor Fix: teditorx.prg -- V 2.0 2003/11/17 + * Copyright 2003 Lance Owens + * + * This Revised Version has a completely rewritten edit method key commands, with dynamic line & paragraqph reformatting. + * Includes a fix for the bugs in Teditor key processing that previously caused array errors + * + * Note: --If using the paste function to enter text, increase size of keyboard buffer to 2048 or 4096! + * Otherwise buffer will overrun -- it takes some processor time to do all the dynamic reformatting + * --SetCursor() is used to change cursor between insert and overwrite. Modify if desired.... + * This will need to be cleared to return to original cursor within Memoedit()!! + * --K_LEFT is set to exit Memoedit() in read-only mode, in addition to the standard exit keys ESC. + * --CHR(141)+CHR(10) "soft CR" inserted by Clipper memoedit() is automatically removed when encountered in text + * --Color persistence problems in previous version corrected by taking setcolor() at Method New file call. + * + * Modifications are based upon the following source file: + */ + +#include "common.ch" +#include "hbclass.ch" +#include "error.ch" +#include "fileio.ch" +#include "inkey.ch" +#include "setcurs.ch" +#include "color.ch" +#include "hbgtinfo.ch" + +//-------------------------------------------------------------------// + +CREATE CLASS XHBEditor + + DATA cFile INIT "" // name of file being edited + + DATA aText INIT {} // array with lines of text being edited + + DATA nTop // boundaries of editor window, without box around + DATA nLeft + DATA nBottom + DATA nRight + + DATA nFirstCol INIT 1 // FirstCol/Row of current text visible inside editor window + DATA nFirstRow INIT 1 + DATA nRow INIT 1 // Cursor position inside aText (nRow) and inside current line of text (nCol) + DATA nCol INIT 1 + + DATA nPhysRow INIT 0 // Hardware cursor position, I cannot rely on Row()/Col() because I could be inside another + DATA nPhysCol INIT 0 // application/object and this one could be moving real cursor. If I'm running full + // screen nPhysRow will always have the same value as Row() and nPhysCol as Col() + + DATA nTextRow INIT 0 // Display position of the cursor whitin the text buffer. + DATA nTextCol INIT 0 // idem. + DATA nWndRow INIT 0 // Initial position of cursor whitin text window. + DATA nWndCol INIT 0 // idem. + + DATA nNumCols INIT 1 // How many columns / rows can be displayed inside editor window + DATA nNumRows INIT 1 + + DATA nTabWidth INIT 5 // Size of Tab chars + DATA lEditAllow INIT .T. // Are changes to text allowed? + DATA lSaved INIT .F. // True if user exited editor with K_CTRL_W + DATA lWordWrap INIT .T. // .f. earlier, True if word wrapping is active + DATA nWordWrapCol INIT 0 // At which column word wrapping occurs + DATA lChanged INIT .F. // .T. if there are changes not saved + DATA lExitEdit INIT .F. // .T. if user requested to end Edit() method + + DATA cColorSpec INIT SetColor() // Color string used for screen writes + + DATA lRightScroll INIT .T. // MARKER TO SET LINE SCROLLING OF R_KEY + DATA nMarkPos // Mark proper new position of cursor when wrapping and splitting lines + DATA nMarkLen + DATA nOrigCursor INIT SetCursor() // Save to restore original cursor format on exit + + DATA ProcName INIT "" + DATA ProcLine INIT 0 + + DATA nCurrentCursor INIT SetCursor() + + DATA lSelActive INIT .F. + DATA nRowSelStart INIT 0 // First row selected + DATA nRowSelEnd INIT 0 // Last row selected + DATA nColSelRow INIT 0 // Row of col selected + DATA nColSelStart INIT 0 // First col selected + DATA nColSelEnd INIT 0 // Last col selected + + // Class DATA can be faster, but since the user can change directly + // READINSERT(), ::lInsert must check in it. + // DATA lInsert INIT .F. // Is editor in Insert mode or in Overstrike one? Default : Overstrike - Clipper + METHOD lInsert() BLOCK { | | Set( _SET_INSERT ) } + METHOD _lInsert( lInsert ) BLOCK { | Self, lInsert | HB_SYMBOL_UNUSED( Self ), IIF( ISLOGICAL( lInsert ), Set( _SET_INSERT, lInsert ), Set( _SET_INSERT ) ) } + + METHOD New( cString, nTop, nLeft, nBottom,; // Converts a string to an array of strings splitting input string at EOL boundaries + nRight, lEditMode, nLineLength, nTabSize, nTextRow, nTextCol, nWndRow, nWndCol ) + + METHOD LoadFile( cFileName ) // Load cFileName into active editor + METHOD LoadText( cString ) // Load cString into active editor + METHOD SaveFile() // Save active file ( not for MemoEdit() emulation ) + + METHOD AddLine( cLine, lSoftCR ) // Add a new Line of text at end of current text + METHOD InsertLine( cLine, lSoftCR, nRow ) // Insert a line of text at a defined row + METHOD RemoveLine( nRow ) // Remove a line of text + METHOD GetLine( nRow ) // Return line n of text + METHOD LineLen( nRow ) INLINE iif(nRow==NIL,nRow:=::nRow,), iif( nRow <= ::LastRow(), Len( ::aText[ nRow ]:cText ), 0 ) // Return text length of line n + METHOD SplitLine( nRow ) // If a line of text is longer than nWordWrapCol divides it into multiple lines + METHOD GotoLine( nRow ) // Put line nRow at cursor position + METHOD GotoCol( nCol ) // Put line nCol at cursor position + METHOD GotoPos( nRow, nCol, lRefresh ) + METHOD GetText( lSoftCR ) // Returns aText as a string ( for MemoEdit() return ) + METHOD DelText() // Clear aText + METHOD AddText( cString, lAtPos ) // Add text at the cursor + METHOD GetTextIndex() // Return current cursor position in text. + + METHOD SetTextSelection( cAction, nCount ) // Start or modify the current selection. + METHOD GetTextSelection( lSoftCr ) // Return the current selection. + METHOD DelTextSelection() // Delete the current selection + METHOD ClrTextSelection() // Clear the current selection. + + METHOD RefreshWindow() // Redraw a window + METHOD RefreshLine( lRefreshColSel ) // Redraw a line + METHOD RefreshColumn() // Redraw a column of text + + METHOD LineColor( nRow ) // Returns color string to use to draw nRow ( current line if nRow is empty ) + METHOD ColColor() // Returns color string to use to draw nCol ( current line if nCol is empty ) + + METHOD MoveCursor( nKey ) // Move cursor inside text / window ( needs a movement key ) + METHOD InsertState( lInsState ) // Changes lInsert value and insertion / overstrike mode of editor + METHOD Edit( nPassedKey ) // Handles input ( can receive a key in which case handles only this key and then exits ) + + METHOD KeyboardHook() // Gets called every time there is a key not handled directly by HBEditor + METHOD IdleHook() // Gets called every time there are no more keys to hanlde just before HBEditor blocks itself waiting for a char + + METHOD Resize( nTop, nLeft, nBottom, nRight ) // Redefines editor window size and refreshes it + METHOD SetColor( cColorString ) // Sets/retrieves color used for screen writes + METHOD Hilite() // Start Hilighting swapping first two color definitions inside cColorSpec + METHOD DeHilite() // Stop Hilighting + + METHOD SetPos( nRow, nCol ) // Updates ::nPhysRow, ::nPhysCol and then calls SetPos() to move hardware cursor + METHOD Row() INLINE ::nPhysRow // Same as clipper ones, returns ::nPhysRow value + METHOD Col() INLINE ::nPhysCol // Same as clipper ones, returns ::nPhysCol value + + METHOD Down() + METHOD PageDown() + METHOD Bottom() + METHOD GoBottom() + + METHOD Up() + METHOD PageUp() + METHOD Top() + METHOD GoTop() + + METHOD Right() + METHOD WordRight() + METHOD End() + + METHOD Left() + METHOD WordLeft() + METHOD Home() + + METHOD K_Ascii( nKey ) + METHOD K_Return() + METHOD K_Del() + METHOD K_Bs() + METHOD K_Tab() + METHOD K_Mouse( nKey ) + METHOD K_Esc() + + // 2006/07/19 - E.F. - Added datas and methods. + DATA cInsLabel // label to display at toggle insert. + DATA lVerticalScroll INIT .T. // True if vertical scrolling is active (default). + DATA bKeyBlock // To process set key codeblock + + METHOD DisplayInsert( lInsert ) // Show message at top of screen. + METHOD LastRow() INLINE Len( ::aText ) // Replace old ::naTextLen + METHOD DelTextRight( nRow ) // Delete text right of cursor. + METHOD DelWordRight() // Delete word right key. + METHOD ReformParagraph() // Reformat paragraph. CTRL-B behaviour + ///////////////// + + PROTECTED: + + METHOD BrowseText( nPassedKey, lHandleOneKey ) + + // 2006/07/25 - E.F. - Internal use only. + METHOD GetCol( nRow, nCol ) INLINE iif(nRow>0.and.nRow<=::LastRow(),iif(nCol>0.and.nCol<=Min(::nWordWrapCol+1,::LineLen(nRow)),::aText[ nRow ]:cText[ nCol ],""),"") + METHOD IsEmptyLine( nRow ) INLINE iif(nRow>0.and.nRow<=::LastRow(),Empty(::aText[ nRow ]:cText ),.T.) + +ENDCLASS + +//-------------------------------------------------------------------// + +METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabSize, nTextRow, nTextCol, nWndRow, nWndCol ) CLASS XHBEditor + + default cString to "" + default nTop to 0 + default nLeft to 0 + default nBottom to MaxRow() + default nRight to MaxCol() + default lEditMode to .T. + default nLineLength to NIL + default nTabSize to NIL + default nTextRow to 1 + default nTextCol to 0 // 1 Clipper Documentations says it is 0 + default nWndRow to 0 // 1 " + default nWndCol to 0 // 1 " + + // 2006/JUL/22 - E.F. To avoid run time error. + IF nTop > nBottom .OR. nLeft > nRight + Throw( ErrorNew( "BASE", 0, 1127, "Argument error: " , Procname() ) ) + ENDIF + + + // fix setcolor() to value at New() call + ::cColorSpec := setcolor() + + // Note original cursor to restore after editing + ::nOrigCursor := SetCursor() + + + // 2006/JUL/21 - E.F. To avoid out of boundaries. + // Editor window boundaries + ::nTop := Min( Max(0,nTop), MaxRow() ) + ::nLeft := Min( Max(0,nLeft), MaxCol() ) + ::nBottom := Max( 0, Min( MaxRow(),nBottom ) ) + ::nRight := Max( 0, Min( MaxCol(),nRight ) ) + + + // How many cols and rows are available + ::nNumCols := ::nRight - ::nLeft + 1 + ::nNumRows := ::nBottom - ::nTop + 1 + + // 2006/AUG/18 - E.F. Adjusted nLineLenght in accordance with Clipper's + // memoedit. + //. + if !Hb_IsNumeric( nLineLength ) + nLineLength := ::nNumCols + else + if nLineLength < 0 + nLineLength := 255 + ::lWordWrap := .f. + else + nLineLength := Max(6,nLineLength) + endif + endif + + ::nWordWrapCol := nLineLength - 1 // please don't change it. + + + if lEditMode != NIL + ::lEditAllow := lEditMode + endif + + // set correct insert state + if ::lEditAllow + // Force to redraw INS message + ::InsertState( ! SET( _SET_INSERT ) ) + ::InsertState( ! SET( _SET_INSERT ) ) + endif + + // No need to save + ::lChanged := .F. + + // how many spaces for each tab? + if nTabSize != NIL + ::nTabWidth := nTabSize + endif + + ::nTextRow := max( 1, nTextRow ) + ::nTextCol := max( 0, nTextCol ) + ::nWndRow := max( 0, nWndRow ) + ::nWndCol := max( 0, nWndCol ) + + ::nFirstRow := max( 1, ::nTextRow - ::nWndRow ) + ::nFirstCol := max( 1, ::nTextCol - ::nWndCol ) + + + // If memofield was created with Clipper, it needs to have chr( 141 )+chr( 10 ) stripped + + // 2006/JUL/20 - E.F. - We should not replace SoftCR with chr(32). + // See Text2Array function for more details. + /* + * if chr( 141 ) $ cString + * acsn := chr( 32 ) + chr( 141 ) + chr( 10 ) + * cString := STRTRAN( cString, acsn, " " ) + * acsn := chr( 141 ) + chr( 10 ) + * cString := STRTRAN( cString, acsn, " " ) + * endif + */ + + + // Load text to internal array. + // TODO: if at ME_INIT mode (when udf is called), the ::lWordWrap is toggled + // to .F. (default is .t.), the should not be splitted, but + // in the Text2Array function the will be splitted in + // accordance with nLineLength. + // + ::aText := Text2Array( cString, nLineLength ) + + if ::LastRow() == 0 + AAdd( ::aText, HBTextLine():New() ) + endif + + // Setting datas that depend of ::aText filled. + // + ::nRow := max( 1, min( ::nTextRow, Len( ::aText ) ) ) + ::nCol := max( 1, min( Len( ::aText[ ::nRow ]:cText ) , ::nTextCol + 1 ) ) + + // extra sanitization over max bounds + IF ::nFirstRow > ::LastRow() + ::nFirstRow := ::LastRow() + ENDIF + + IF ::nFirstCol > ::LineLen( ::nRow ) + 1 + ::nFirstCol := ::LineLen( ::nRow ) + 1 + ENDIF + + + // Set cursor position; also initializes phisical to virtual mapping + //::SetPos( ::nTop + ::nRow - ::nFirstRow, ::nLeft + ::nCol - ::nFirstCol ) + ::SetPos( ::nTop + ::nWndRow, ::nLeft + ::nWndCol ) + + ::RefreshWindow() + +return Self + +//-------------------------------------------------------------------// +// +// Redefines editor window size and refreshes it +// +METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS XHBEditor + + // don't change coordinates not given + default nTop to ::nTop + default nLeft to ::nLeft + default nBottom to ::nBottom + default nRight to ::nRight + + ::nTop := nTop + ::nLeft := nLeft + ::nBottom := nBottom + ::nRight := nRight + + // How many cols and rows are available + // + ::nNumCols := ::nRight - ::nLeft + 1 + ::nNumRows := ::nBottom - ::nTop + 1 + + // FirstCol/Row of current text visible inside editor window + // + ::nFirstCol := 1 + ::nFirstRow := 1 + + // Cursor position inside aText ( nRow ) and inside current line of text ( nCol ) + // + ::nRow := 1 + ::nCol := 1 + + // Set cursor upper left corner + ::SetPos( ::nTop, ::nLeft ) + + ::RefreshWindow() + +return Self + +//-------------------------------------------------------------------// +// +// Screen Output +// +//-------------------------------------------------------------------// +// +// Redraws a screenfull of text +// +METHOD RefreshWindow() CLASS XHBEditor + + LOCAL i + LOCAL nOCol + LOCAL nORow + LOCAL nOCur + + + nOCol := ::Col() + nORow := ::Row() + nOCur := SetCursor( SC_NONE ) + + DispBegin() + + // This breaks individual line coloring, so I restored the old version with + // a small optimization. -- Ph.Krylov + // CLEAR THE WHOLE WINDOW!!! previous version wished to spare some output, but + // C is faster than a VM loop!! + // + //ScrollFixed( ::nTop, ::nLeft, ::nBottom, ::nRight ) + + for i := 0 to Min( ::nNumRows - 1, ::LastRow() - 1 ) + + // 2006/JUL/23 - E.F. Adjusted to avoid out of bound. + // Don't replace ::GetLine(nRow) by ::aText[nRow]:cText here, + // because getline return line number in tbrwtext.prg (debug). + DispOutAt( Min(::nTop + i,::nBottom), ::nLeft, ; + PadR( iif(::nFirstRow+i <= ::LastRow(), SubStr( ::GetLine( ::nFirstRow + i ), ::nFirstCol, ::nNumCols ),Space(::nNumCols) ) , ::nNumCols ), ; + ::LineColor( ::nFirstRow + i ) ) + + next + + ScrollFixed( ::nTop + i, ::nLeft, ::nBottom, ::nRight ) + + DispEnd() + + SetCursor( nOCur ) + ::SetPos( nORow, nOCol ) + +return Self + +//-------------------------------------------------------------------// +// +// Return the color of the row +// +METHOD LineColor( nRow ) CLASS XHBEditor + + local cColor + + if ::lSelActive .and. ( ( nRow >= ::nRowSelStart ) .and. ( nRow <= ::nRowSelEnd ) ) .and.; + ::nRowSelStart > 0 .and. ::nRowSelEnd > 0 + cColor := hb_ColorIndex( ::cColorSpec, CLR_ENHANCED ) + else + cColor := hb_ColorIndex( ::cColorSpec, CLR_STANDARD ) + endif + +return cColor +//-------------------------------------------------------------------// +// +// Return the color of the Col +// +METHOD ColColor() CLASS XHBEditor + + local cColor + + if ::lSelActive .and. ::nColSelStart > 0 .and. ::nColSelEnd > 0 .and.; + ::nColSelStart <= ::nColSelEnd + cColor := hb_ColorIndex( ::cColorSpec, CLR_ENHANCED ) + else + cColor := hb_ColorIndex( ::cColorSpec, CLR_STANDARD ) + endif + +return cColor + +//-------------------------------------------------------------------// +// +// Redraws current screen line +// +METHOD RefreshLine( lRefreshColSel ) CLASS XHBEditor + + LOCAL nOCol + LOCAL nORow + LOCAL nCol,nFirstCol + + DEFAULT lRefreshColSel TO .F. + + IF ::nRow <= ::LastRow() + + nOCol := ::Col() + nORow := ::Row() + + Dispbegin() + + // 2006/AUG/02 - E.F. + // Don't replace ::GetLine(nRow) by ::aText[nRow]:cText here + // because getline return line number in tbrwtext.prg (debug). + DispOutAt( ::Row(), ::nLeft, PadR( SubStr( ::GetLine( ::nRow ), ::nFirstCol, ::nNumCols ), ::nNumCols, " " ), ::LineColor( ::nRow ) ) + + if lRefreshColSel + + nFirstCol := Max(::nTextCol,::nWndCol) + nFirstCol := Max(nFirstCol,::nLeft) + +/* 2006/SEP/20 - E.F. - Fine cursor adjustment. */ +// nCol := nFirstCol + ::nColSelStart - 1 + nCol := Max( ::nLeft, nFirstCol + ::nColSelStart - 1 ) + + DispOutAt( ::Row(), nCol, SubStr( ::GetLine( ::nRow ), Max(1,::nColSelStart), (::nColSelEnd - ::nColSelStart+1) ) , ::ColColor() ) + + endif + + Dispend() + + ::SetPos( nORow, nOCol ) + + ENDIF + +return Self + +//-------------------------------------------------------------------// +// +// Refreshes only one screen column of text ( for Left() and Right() movements ) +// +METHOD RefreshColumn() CLASS XHBEditor + + LOCAL i + LOCAL nOCol + LOCAL nORow + LOCAL nOCur + + nOCol := ::Col() + nORow := ::Row() + nOCur := SetCursor( SC_NONE ) + + Dispbegin() + + // 2006/AUG/02 - E.F. + // Don't replace ::GetLine(nRow) by ::aText[nRow]:cText here + // because getline return line number in tbrwtext.prg (debug). + for i := 0 to Min( ::nNumRows - 1, ::LastRow() - 1 ) + DispOutAt( ::nTop + i, nOCol, SubStr( ::GetLine(::nFirstRow + i ), ::nCol, 1 ), ::LineColor( ::nFirstRow + i ) ) + next + + Dispend() + + SetCursor( nOCur ) + ::SetPos( nORow, nOCol ) + +return Self + +//-------------------------------------------------------------------// +// +// Wrapper for Cursor Movement to be used from Outside of This Class +// +//-------------------------------------------------------------------// + +METHOD MoveCursor( nKey ) CLASS XHBEditor + // Modified to handle cursor movements inside text array without crashing! + // Modified to allow line wrapping, and to track cursor to line ends. + // + Switch nKey + + // TODO: for optimization, change this with relativie GOTOCOL, GOTOPOS and GOTOROW + case K_DOWN + ::ClrTextSelection() + ::Down() + exit + + case K_PGDN + ::ClrTextSelection() + ::PageDown() + exit + + case K_CTRL_PGDN + ::ClrTextSelection() + ::GoBottom() + exit + + case K_UP + ::ClrTextSelection() + ::Up() + exit + + case K_PGUP + ::ClrTextSelection() + ::PageUp() + exit + + case K_CTRL_PGUP + ::ClrTextSelection() + ::GoTop() + exit + + case K_RIGHT + ::ClrTextSelection() + ::Right() + exit + + case K_CTRL_RIGHT + ::ClrTextSelection() + ::WordRight() + exit + + case K_LEFT + ::ClrTextSelection() + ::Left() + exit + + case K_CTRL_LEFT + ::ClrTextSelection() + ::WordLeft() + exit + + case K_HOME + ::ClrTextSelection() + ::Home() + exit + + case K_CTRL_HOME + ::ClrTextSelection() + ::Top() + exit + + case K_END + ::ClrTextSelection() + ::End() + exit + + case K_CTRL_END + ::ClrTextSelection() + ::Bottom() + ::End() + exit + + otherwise + return .F. + + endswitch + +return .T. + +//-------------------------------------------------------------------// +// +// Editing +// +//-------------------------------------------------------------------// + +METHOD Edit( nPassedKey ) CLASS XHBEditor + + LOCAL nKey + LOCAL lSingleKeyProcess := .F. + + + // If user pressed an exiting key ( K_ESC or K_ALT_W ) or I've received + // a key to handle and then exit + + DO WHILE ! ::lExitEdit .AND. ! lSingleKeyProcess + + // If I haven't been called with a key already preset, evaluate + // this key and then exit. + // + if nPassedKey == NIL + + if NextKey() == 0 + ::IdleHook() + endif + + nKey := InKey( 0, INKEY_ALL ) + + else + + lSingleKeyProcess := .T. + nKey := nPassedKey + + endif + + /* + * 2006/AUG/12 -E.F. Trap Set key only if nKey is nil. + */ + IF nPassedKey == NIL + if ( ::bKeyBlock := Setkey( nKey ) ) != NIL + Eval( ::bKeyBlock, ::ProcName, ::ProcLine, "", Self ) + Loop + endif + ENDIF + + Switch nKey + case K_LBUTTONUP + case K_MWFORWARD + case K_MWBACKWARD + ::K_Mouse( nKey ) + exit + +#ifdef HB_EXT_INKEY + + case K_SH_DOWN + if ::nRow <= ::LastRow() + ::SetTextSelection( "ROW", +1 ) + endif + exit + + case K_SH_UP + if ::nRow > 1 + ::SetTextSelection( "ROW", -1 ) + endif + exit + + case K_SH_RIGHT + if ::nCol < ::nWordWrapCol + 1 + ::SetTextSelection( "COL", +1 ) + endif + exit + + case K_SH_END + if ::nCol < ::nWordWrapCol + 1 + ::SetTextSelection( "END" ) + endif + exit + + case K_SH_LEFT + if ::nCol > 1 + ::SetTextSelection( "COL", -1 ) + endif + exit + + case K_SH_HOME + if ::nCol > 1 + ::SetTextSelection( "HOME" ) + endif + exit + + case K_CTRL_A // Select all + ::SetTextSelection( "ALL" ) + exit + + case K_CTRL_C // Copy + hb_gtInfo( GTI_CLIPBOARDDATA, ::GetTextSelection() ) + //::ClrTextSelection() + exit + + case K_CTRL_X // Cut + case K_SH_DEL // Cut + hb_gtInfo( GTI_CLIPBOARDDATA, ::GetTextSelection() ) + if ::lEditAllow + ::DelTextSelection() + endif + exit + + case K_CTRL_V // Paste + case K_SH_INS // Paste + if ::lEditAllow + ::AddText( strtran( hb_gtInfo( GTI_CLIPBOARDDATA ), chr(0), chr(32) ), .T. ) + ::ClrTextSelection() + endif + exit + + case K_ALT_W // Exit and return text buffer content. + case K_CTRL_W // idem + ::lSaved := .T. + ::lExitEdit := .T. + SetCursor( ::nOrigCursor ) // restore original cursor saved at startup + exit + + case K_CTRL_END + ::ClrTextSelection() + ::Bottom() + ::End() + exit + + case K_CTRL_B // Reformat paragraph + if ::lEditAllow + ::ClrTextSelection() + ::ReformParagraph() // 2006/JUL/29 -E.F. Added. + endif + exit +#else + case K_ALT_W + exit + + case K_CTRL_W + ::lSaved := .T. + ::lExitEdit := .T. + SetCursor( ::nOrigCursor ) // restore original cursor saved at startup + exit +#endif + + + case K_CTRL_N + if ::lEditAllow // Clipper compatibility + ::ClrTextSelection() + ::lChanged := .T. + ::Home() + ::InsertLine( "", .F., ::nRow ) + ::RefreshLine() + ::RefreshWindow() + endif + exit + + case K_CTRL_T + if ::lEditAllow + ::ClrTextSelection() + ::lChanged := .T. + ::DelWordRight() + ::RefreshLine() + endif + exit + + case K_CTRL_Y + if ::lEditAllow // Clipper compatibility + ::lChanged := .T. + ::ClrTextSelection() + if ::LastRow() > 1 .AND. ::nRow < ::LastRow() + ::RemoveLine( ::nRow ) + ::RefreshWindow() + if ::LastRow()>0 + ::Home() + ::RefreshLine() + endif + else + ::aText[ ::nRow ]:cText := "" + ::RefreshLine() + ::Home() + ::RefreshLine() + endif + endif + exit + + case K_DOWN + ::ClrTextSelection() + ::Down() + exit + + case K_PGDN + ::ClrTextSelection() + ::PageDown() + exit + + case K_CTRL_PGDN + ::ClrTextSelection() + ::GoBottom() + exit + + case K_UP + ::ClrTextSelection() + ::Up() + exit + + case K_PGUP + ::ClrTextSelection() + ::PageUp() + exit + + case K_CTRL_PGUP + ::ClrTextSelection() + ::GoTop() + exit + + case K_RIGHT + ::ClrTextSelection() + ::Right() + exit + + case K_CTRL_RIGHT + ::ClrTextSelection() + ::WordRight() + exit + + case K_LEFT + ::ClrTextSelection() + ::Left() + exit + + case K_CTRL_LEFT + ::ClrTextSelection() + ::WordLeft() + exit + + case K_HOME + ::ClrTextSelection() + ::Home() + exit + + case K_CTRL_HOME + ::ClrTextSelection() + ::Top() + exit + + case K_END + ::ClrTextSelection() + ::End() + exit + + case K_ESC + ::ClrTextSelection() + ::K_Esc() + exit + + case K_RETURN + ::ClrTextSelection() + ::K_Return() + exit + + case K_INS + // 2006/JUL/22 - E.F. - Insert is allowed only in edit mode. + if ::lEditAllow + ::ClrTextSelection() + ::InsertState( !::lInsert ) + endif + exit + +#ifdef HB_EXT_INKEY + case K_DEL + if ::lSelActive .and. ::lEditAllow + ::DelTextSelection() + elseif ::lEditAllow // Clipper compatibility + ::K_Del() + endif + exit +#else + case K_DEL + if ::lEditAllow // Clipper compatibility + ::K_Del() + endif + exit +#endif + case K_TAB + if ::lEditAllow // Clipper compatibility + ::ClrTextSelection() + ::K_Tab() + endif + exit + + case K_BS + ::ClrTextSelection() + if ::lEditAllow // Clipper compatibility + ::K_Bs() + else + // 2006/JUL/22 - E.F. - Clipper backspace in read only is same as left movement. + ::Left() + endif + exit + + case K_CTRL_BS // block chr( 127 ), a printable character in windows + ::ClrTextSelection() + exit + + otherwise + + if nKey >= K_SPACE .AND. nKey < 256 + if ::lEditAllow + ::ClrTextSelection() + ::K_Ascii( nKey ) + endif + else + // NOTE: if you call ::Edit() with a key that is passed to ::KeyboardHook() and then + // ::KeyboardHook() calls ::Edit() with the same key you end up with an endless loop + ::ClrTextSelection() + ::KeyboardHook( nKey ) + endif + + endswitch + + ENDDO + +Return Self + +//-------------------------------------------------------------------// +// +// Vertical Navigation +// +//-------------------------------------------------------------------// + +METHOD Down() CLASS XHBEditor + + IF ::lVerticalScroll + IF ::nRow < ::LastRow() + ::GotoLine( ::nRow + 1 ) + ENDIF + ELSE + IF ::nFirstRow < ::LastRow() .AND. ::LastRow() > ::nNumRows + ::nFirstRow++ + ::nRow++ + if ::nRow > ::LastRow() + ::nRow-- + endif + ::RefreshWindow() + ELSEIF ::nRow < ::LastRow() + ::GotoLine( ::nRow + 1 ) + ENDIF + ENDIF + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD PageDown() CLASS XHBEditor + LOCAL nJump + + nJump := Min( ::nNumRows, ::LastRow() - ::nFirstRow - ( ::nPhysRow - ::nTop ) ) + +IF ::lVerticalScroll + + IF nJump > (::LastRow() - ::nRow) //nJump < ::nNumRows + ::Bottom() + ELSE + ::nFirstRow += nJump + if ::nFirstRow > ::LastRow() + ::nFirstRow := ::LastRow() + endif + + ::nRow += nJump + if ::nRow > ::LastRow() + ::nRow := ::LastRow() + endif + ::RefreshWindow() + ENDIF + // ::GotoLine( min( ::nRow + ::nNumRows - 1, ::LastRow() ) ) + +ELSE + nJump := Min( nJump, ::LastRow() - ::nFirstRow + 1 ) + ::nFirstRow += nJump + ::nRow += nJump + ::RefreshWindow() +ENDIF + +Return Self + +//-------------------------------------------------------------------// + +METHOD Bottom() CLASS XHBEditor + LOCAL nRowTo := min( ::nFirstRow + ::nNumRows-1, ::LastRow() ) + + ::GotoLine( nRowTo ) + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD GoBottom() CLASS XHBEditor + + ::GotoPos( ::LastRow(), ::LineLen( ::LastRow() ) + 1, .T. ) + +Return Self + +//-------------------------------------------------------------------// + +METHOD Up() CLASS XHBEditor + + IF ::lVerticalScroll + IF ::nRow > 1 + ::GotoLine( ::nRow - 1 ) + //::GotoPos( ::nRow - 1, ::nCol ) + ENDIF + ELSE + IF ::nFirstRow > 1 + ::nFirstRow-- + ::nRow-- + if ::nRow < 1 + ::nRow := 1 + endif + ::RefreshWindow() + ELSEIF ::nRow > 1 + ::GotoLine( ::nRow - 1 ) + ENDIF + ENDIF + +Return Self + +//-------------------------------------------------------------------// + +METHOD PageUp() CLASS XHBEditor + LOCAL nJump + + nJump := min( ::nNumRows, ::nFirstRow - 1 ) + +IF ::lVerticalScroll + if nJump == 0 + ::GoToLine( 1 ) + else + ::nFirstRow -= nJump + if ::nFirstRow < 1 + ::nFirstRow := 1 + endif + + ::nRow -= nJump + if ::nRow < 1 + ::nRow := 1 + endif + ::RefreshWindow() + endif + + // ::GotoLine( Max( 1, ::nRow - ::nNumRows ) ) +ELSE + nJump := Min( nJump, ::nNumRows - 1 ) + ::nFirstRow -= nJump + ::nRow -= nJump + ::RefreshWindow() + +ENDIF + + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD Top() CLASS XHBEditor + + ::GotoPos( ::nFirstRow, 1, .T. ) + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD GoTop() CLASS XHBEditor + + ::GotoPos( 1, 1 ) + +RETURN Self + +//-------------------------------------------------------------------// +// +// Horizontal Navigation +// +//-------------------------------------------------------------------// + +METHOD Right() CLASS XHBEditor + + if ( ::lWordWrap ) + // 2006/07/19 - E.F. Changed max right point to pos cursor to next. + // + IF ::nCol > ::nWordWrapCol .AND. ::nRow < ::LastRow() + ::GotoPos( ::nRow + 1, 1, .T. ) + ELSE + /* ::GotoCol( ::nCol + 1 ) does not correctly redraw the screen + * if K_RIGHT is stuffed into the keyboard buffer; use GotoPos() + * Gotocol checks for line bounds also; as the IF should check for a + * method too, theres no spare in IF here. + * ::GotoCol( ::nCol + 1 ) + */ + ::GotoPos( ::nRow, ::nCol + 1, .T.) + ENDIF + else + if ::nCol < Max(::nNumCols,::nWordWrapCol+1) + //::GotoCol( ::nCol + 1 ) + ::GotoPos( ::nRow, ::nCol+1 , .T. ) + endif + endif + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD WordRight() CLASS XHBEditor +LOCAL nMaxCol := Min( ::nWordWrapCol+1, ::LineLen( ::nRow ) ) + + // NOTE: should be faster without call to ::GetLine() + // + + if !::lWordWrap .and. ::IsEmptyLine( ::nRow ) .OR.; + ::LastRow()==0 .OR.; + ( At(" ", ::aText[ ::nRow ]:cText ) == 0 .AND. ::LineLen(::nRow) >= ::nWordWrapCol ) + return self + endif + + dispbegin() // to minimize flicker. + + // 2006/JUL/21 - E.F. Changed to verify empty character instead space. + // In any circunstancies wordright stop at space. + // Added verification in not wordwrap mode if reach + // rightmost position. + // + + do while ::nCol <= nMaxCol .AND. !Empty( ::GetCol( ::nRow, ::nCol ) ) + ::Right() + if ::nCol > nMaxCol .OR.; + (!::lWordWrap .AND. ::nCol >= nMaxCol ) + exit + endif + enddo + + do while ::nCol <= nMaxCol .AND. Empty( ::GetCol( ::nRow, ::nCol ) ) + ::Right() + if ::nCol > nMaxCol .OR.; + (!::lWordWrap .AND. ::nCol >= nMaxCol ) + exit + endif + enddo + + if !::lWordWrap + do while ::nCol > 1 .AND. !Empty( ::GetCol( ::nRow, ::nCol ) ) + ::Left() + enddo + do while ::nCol < nMaxCol .AND. empty( ::GetCol(::nRow,::nCol ) ) + ::right() + enddo + endif + + // mod = move to next line + // + + If ::lRightScroll + if ::lWordWrap + // 2006/JUL/21 - E.F. - If cursor reach rightmost position + // go to the next line. + if ::nCol > nMaxCol .and. ::nRow < ::LastRow() + ::Down() + ::Home() + if Empty(::GetCol( ::nRow, ::nCol )) + ::WordRight() + endif + // 2006/JUL/21 - E.F. - If cursor stop at empty char and it is the + // last reachable position go back to the previous word. + elseif ::nCol >= nMaxCol .and. ::nRow == ::LastRow() + if !Empty( ::GetCol( ::nRow, ::nCol ) ) + ::end() + endif + ::WordLeft() + elseif ::nCol == 1 .and. Empty( ::GetCol( ::nRow, ::nCol ) ) + ::WordRight() + endif + else + // 2006/JUL/21 - E.F. - If cursor reach rightmost position go to back to prior word. + if ::nCol > nMaxCol + ::Wordleft() + endif + endif + endif + + dispend() + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD End() CLASS XHBEditor + + // 2006/07/19 - E.F. Changed to avoid the cursor out of line. + // + ::GotoCol( Min( ::LineLen( ::nRow )+1, Max(::nNumCols,::nWordWrapCol+1)) ) + +Return Self + +//-------------------------------------------------------------------// + +METHOD Left() CLASS XHBEditor + // Gotocol checks for nCol > 1 also, but this saves a func call + IF ::nCol == 1 + if ( ::lWordWrap ) + IF ::nRow > 1 + // 2006/07/19 E.F. left should be at max in the leftmost column. + // + ::GotoPos(::nRow - 1, Max(::nNumCols,::nWordWrapCol+1) , .T. ) + ENDIF + //else do nothing + endif + ELSE + ::GotoCol( ::nCol - 1 ) + ENDIF +RETURN Self + +//-------------------------------------------------------------------// + +METHOD WordLeft() CLASS XHBEditor + + // splitline() does not use this function + // modifed to wrap lines and position at first letter of word, not word end + // + + if !::lWordWrap .and. ::IsEmptyLine( ::nRow ) .OR. ::LastRow()==0 + Return self + endif + + dispbegin() // to minimize flicker + + if ::lWordWrap .and. ::nCol == 1 .and. ::nRow > 1 + ::Up() + ::End() + do while ::nCol == 1 .and. ::nRow > 1 .AND. Empty( ::GetCol( ::nRow,::nCol ) ) + ::Up() + if !::IsEmptyLine( ::nRow ) + ::End() + exit + endif + enddo + endif + + + // 2006/JUL/21 - E.F. - Changed to verifiy empty char instead space. In any + // circunstancies wordleft stop at space. + // + do while ::nCol > 1 .AND. !Empty( ::GetCol( ::nRow, ::nCol ) ) + ::Left() + enddo + do while ::nCol > 1 .AND. Empty( ::GetCol( ::nRow, ::nCol ) ) + ::Left() + enddo + do while ::nCol > 1 .AND. !Empty( ::GetCol( ::nRow, ::nCol-1 ) ) // move to front of word + ::Left() + enddo + + // 2006/JUL/24 -E.F. - If cursor stoped at empty char, then + // go to the next word. + if !::lWordWrap .AND. ; + ::nCol < ::LineLen(::nRow) .and.; + Empty( ::GetCol( ::nRow,::nCol ) ) + ::WordRight() + elseif ::lWordWrap .and. ::nCol=1 .and. ::nRow=1 .and.; + Empty( ::GetCol( ::nRow,::nCol ) ) + ::WordRight() + elseif ::lWordWrap .and. ::nCol=1 .and. ::nRow > 1 + do While ::nCol=1 .and. ::nRow>1 .and. empty( ::GetCol( ::nRow, ::nCol ) ) + ::up() + if !::IsEmptyLine( ::nRow ) + ::end() + ::wordLeft() + exit + endif + Enddo + endif + + dispend() + +Return Self + +//-------------------------------------------------------------------// + +METHOD Home() CLASS XHBEditor + + ::GotoCol( 1 ) + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD K_Mouse( nKey ) CLASS XHBEditor + LOCAL nRow, nCol, nJump + + Switch nKey + case K_LBUTTONUP + + nRow := MRow() + nCol := MCol() + + if ( nRow >= ::nTop .and. nRow <= ::nBottom ) + if nCol >= ::nLeft .and. nCol <= ::nRight + if ( ::nRow + ( nJump := nRow - ::nPhysRow ) ) <= ::LastRow() + ::GotoPos( max( 1, ::nRow + nJump ), max( 1, ::nCol + ( nCol - ::nPhysCol ) ), .t. ) + endif + endif + endif + exit + case K_MWFORWARD + ::ClrTextSelection() + ::Up() + exit + case K_MWBACKWARD + ::ClrTextSelection() + ::Down() + exit + end + +RETURN Self + +//-------------------------------------------------------------------// +// +// Keystroke Handelling +// +//-------------------------------------------------------------------// + +METHOD K_Ascii( nKey ) CLASS XHBEditor + + // nKey := ASC( HB_ANSITOOEM( CHR( nKey ) ) ) // convert from windows + + IF !::lEditAllow .OR. ::nCol > ::nWordWrapCol+1 + Return Self + ENDIF + + // 2006/JUL/22 - E.F. - IF there is no line into memo add a new one. + IF ::LastRow() == 0 + ::AddLine("",.F.) + ENDIF + + ::nMarkPos := 0 + + // If I'm past EOL I need to add as much spaces as I need to reach ::nCol + // Always remeber the cursor position is always 1 ahead of buffer + // So adding 1 below - Pritpal Bedi + // + if ::nCol > ::LineLen( ::nRow ) + 1 // At end of line, add room + ::aText[ ::nRow ]:cText += Space( ::nCol - ::LineLen( ::nRow ) ) + ::lChanged := .T. + endif + + // insert char if in insert mode or at end of current line + // + if ::lInsert .OR. ( ::nCol > ::LineLen( ::nRow ) ) + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, Chr( nKey ) ) + ::lChanged := .T. + else + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, Chr( nKey ) ) + ::lChanged := .T. + endif + + // eventually wordwrap + // + IF ::lWordWrap .and. ::LineLen( ::nRow ) > ::nWordWrapCol + ::SplitLine( ::nRow ) + ::Right() + ELSE + ::RefreshLine() + ::Right() + ENDIF + +RETURN Self + +//-------------------------------------------------------------------// +// Backspace +// +METHOD K_Bs() CLASS XHBEditor + + IF !::lEditAllow + ::Left() + RETURN Self + ENDIF + + // xHarbour extension: If backspace reach first column, move cursor to up + // and go to last column. Allow to continue backspace in + // previous line. Clipper memoedit backspace act only at + // same line. + // + IF ::nCol == 1 + + if ( ::lWordWrap ) + + if ::nRow > 1 .AND. ::nRow <= ::LastRow() + + // 2006/JUL/21 - E.F. - Determine new ::nCol position. + // + ::nCol := Min(::LineLen( ::nRow-1 ) + 1,::nWordWrapCol) + + ::nRow -- + + // inherit sibling line's soft CR setting. + ::aText[ ::nRow ]:lSoftCR := ::aText[ ::nRow + 1 ]:lSoftCR + + // remove a SINGLE trailing space, if it exists + IF ::aText[ ::nRow ]:cText[-1] == " " + ::aText[ ::nRow ]:cText := Substr( ::aText[ ::nRow ]:cText, 1, ::LineLen( ::nRow ) - 1 ) + ENDIF + + ::aText[ ::nRow ]:cText += ::aText[ ::nRow + 1 ]:cText + + ::RemoveLine( ::nRow + 1 ) + + // resplit the line. + IF ::LineLen( ::nRow ) > ::nWordWrapCol + // will also refresh + ::SplitLine( ::nRow ) + ENDIF + + // 2006/JUL/21 - E.F. - Delete the rightmost char and pos the cursor on it. + IF ::LineLen( ::nRow ) >= ::nWordWrapCol + ::aText[ ::nRow ]:cText := SubStr( ::aText[ ::nRow ]:cText, 1, ::LineLen(::nRow ) - 1 ) + " " + ::nCol := Min(::nCol+1,::nWordWrapCol+1) + ENDIF + + IF !Empty( ::aText[ ::nRow ]:cText ) + ::GotoPos( ::nRow, ::nCol, .T. ) // also refresh + ELSE + ::GotoPos( ::nRow, 1, .T.) + ENDIF + + endif + endif + + // 2006/JUL/19 - E.F. When backspace reach column 1 and the line is + // empty and exist next line, we need set linelen to + // zero and set lSoftCR to true as Clipper does. + // + IF ::nCol == 1 .AND. Empty( ::aText[ ::nRow ]:cText ) .AND.; + ::nRow+1 <= ::LastRow() + + ::aText[ ::nRow ]:cText := "" + ::aText[ ::nRow ]:lSoftCR := .T. + + ENDIF + + ELSEIF ::nCol >= ::nFirstCol + + // delete previous character + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol-1, 1, "" ) + ::GotoCol( ::nCol -1 ) + ::RefreshLine() + ENDIF + + ::lChanged := .T. + +RETURN Self + +//-------------------------------------------------------------------// +// Process DEL key +// +METHOD K_Del() CLASS XHBEditor + LOCAL lMerge := .F. + LOCAL nCurRow, nCurCol + + IF !::lEditAllow + Return Self + ENDIF + + IF ::nCol > ::LineLen( ::nRow ) //.and. ::nRow < ::LastRow() + // eventually pad. + // + //IF ::nCol > ::LineLen( ::nRow ) + 1 + // ::aText[ ::nRow ]:cText := Padr( ::aText[ ::nRow ]:cText, ::nCol - 1) + //ENDIF + lMerge := .T. + + ELSEIF ::nCol <= ::LineLen( ::nRow ) + // stuff the character + // + + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, "" ) + ::lChanged := .T. + + // in case of softcr, reparse the paragraph. + // + IF ::aText[ ::nRow ]:lSoftCR == .T. + IF ::aText[ ::nRow ]:cText[ -1 ] != " " + ::aText[ ::nRow ]:cText += " " + ENDIF + + // 2006/JUL/21 - E.F. If current line is empty and cursor is in + // the first column, remove it after del. + // + IF ::IsEmptyLine( ::nRow ) .AND. ::nCol == 1 + ::RemoveLine(::nRow) + ENDIF + lMerge := .T. + ELSE + ::RefreshLine() + ENDIF + + ENDIF + + // have we to merge with the next line? + IF lMerge + ::lChanged := .T. + nCurRow := ::nRow + nCurCol := ::nCol + // 2006/07/19 - E.F. Merge line only if ::nRow+1 is valid, + // to avoid bound error. + // + IF ::nRow+1 <= ::LastRow() + // copy the other line + ::aText[ ::nRow ]:cText += ::aText[ ::nRow + 1 ]:cText + // copy its softcr setting + ::aText[ ::nRow ]:lSoftCr := ::aText[ ::nRow + 1 ]:lSoftCr + // remove it. + ::RemoveLine( ::nRow + 1 ) + // and finally split it + IF ::LineLen( ::nRow ) > ::nWordWrapCol + ::SplitLine( ::nRow ) + ENDIF + ENDIF + ::GotoPos( nCurRow, nCurCol, .T. ) + ::RefreshWindow() + ENDIF + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD K_Tab() CLASS XHBEditor + LOCAL lHardCR, i + + IF !::lEditAllow + Return Self + ENDIF + + // insert char if in insert mode or at end of current line + if ::nCol < ::nWordWrapCol - ::nTabWidth - ::nTabWidth + if ::lInsert .OR. ( ::nCol == ::LineLen( ::nRow ) ) + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, Space( ::nTabWidth ) ) + endif + ::lChanged := .T. + + ::lRightScroll := .F. //prevent auto linewrap + for i := 1 to ::nTabWidth + if ::nCol < ::nWordWrapCol - ::nTabWidth - ::nTabWidth + ::Right() + ::RefreshLine() + else + i := ::nTabWidth // end of line, stop it! + endif + next + ::lRightScroll :=.T. + // wrap lines + if ::LineLen( ::nRow )> ::nWordWrapCol + lHardCR := .F. // should already by .F., but just to be safe, and it is a tiny line of code... + + if ::aText[ ::nRow ]:lSoftCR + if !::aText[ ::nRow+1 ]:lSoftCR // the next line has a hard return, keep it + lHardCR := .T. + endif + + if ::nRow == ::LastRow() - 1 // if next to last line of array, last line MUST have HR + lHardCR := .T. + endif + + ::aText[ ::nRow ]:cText := ::aText[ ::nRow ]:cText + ::GetLine( ::nRow + 1 ) + ::RemoveLine( ::nRow + 1 ) + ::aText[ ::nRow ]:lSoftCR := !lHardCR // .T. if lHardCR == .F. + + ::SplitLine( ::nRow ) + ::RefreshWindow() + endif + endif + endif + + Return Self + +//-------------------------------------------------------------------// + +METHOD K_Return() CLASS XHBEditor + + IF ::LastRow()==0 .AND. !::lInsert + Return Self + ENDIF + + IF ::lEditAllow + +// 2006/JUL/24 - E.F. - Fixed at insert mode. +/* +* IF ::lInsert +* IF ::nRow == ::LastRow() +* if ::nCol > ::LineLen( ::nRow ) +* ::AddLine( "", .F. ) +* else +* ::InsertLine( Substr( ::aText[ ::nRow ]:cText, ::nCol ), .F., ::nRow + 1 ) +* endif +* ELSEIF ::aText[ ::nRow ]:lSoftCR +* ::aText[ ::nRow + 1 ]:cText := Substr( ::aText[ ::nRow ]:cText, ::nCol ) +" "+ ::aText[ ::nRow + 1 ]:cText +* ::SplitLine( ::nRow + 1 ) +* ELSE +* ::InsertLine( Substr( ::aText[ ::nRow ]:cText, ::nCol ), .F., ::nRow + 1 ) +* ENDIF +* ::aText[ ::nRow ]:cText := Left( ::aText[ ::nRow ]:cText, ::nCol - 1 ) +* +* ELSEIF ::nRow == ::LastRow() +* ::AddLine( "", .F. ) +* ENDIF +*/ + IF ::lInsert + + IF ::LastRow()==0 + ::AddLine( "", .F. ) + ENDIF + + IF ::nRow == ::LastRow() .AND.; + ::nCol > ::LineLen( ::nRow ) + ::AddLine( "", .F. ) + ELSE + ::InsertLine( Substr( ::aText[ ::nRow ]:cText, ::nCol ), .F., ::nRow + 1 ) + ENDIF + + ::aText[ ::nRow ]:cText := Left( ::aText[ ::nRow ]:cText, ::nCol - 1 ) + + ELSEIF ::nRow == ::LastRow() + ::AddLine( "", .F. ) + ENDIF + + // the current line should not have softcr. + // + ::aText[ ::nRow ]:lSoftCR := .F. + + ENDIF + + // will also refresh + // + IF ::nRow < ::LastRow() + ::GotoPos( ::nRow + 1, 1, .T. ) + ENDIF + + ::lChanged := .T. + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD K_Esc() CLASS XHBEditor + LOCAL cScreenMsg, nCurRow, nCurCol, nCursor,nKey + + ::lExitEdit := .T. + + IF ::lEditAllow .AND. ::lChanged .AND. Set( _SET_SCOREBOARD ) + nCurCol := ::Col() + nCurRow := ::Row() + cScreenMsg := SaveScreen( 0,60,0,77 ) + nCursor := SetCursor( SC_NORMAL ) + @ 0,60 say '(Abort Edit? Y/N)' + nKey := inkey( 0 ) + inkey() + RestScreen( 0, 60, 0, 77, cScreenMsg ) + SetCursor(nCursor) + SetPos( nCurRow,nCurCol ) + + // 2006/JUL/21 - E.F - Exit only if "Y" is pressed. + // + ::lExitEdit := ( Upper( Chr(nKey) ) == "Y" ) + ENDIF + + IF ::lExitEdit + SetCursor( ::nOrigCursor ) // restore original cursor saved at startup + ENDIF + +Return Self + +//-------------------------------------------------------------------// +// +// Data Retrieval Methods +// +//-------------------------------------------------------------------// +// +// Add a new Line of text at end of current text +// +METHOD AddLine( cLine, lSoftCR ) CLASS XHBEditor + + DEFAULT cLine TO "" + DEFAULT lSoftCR TO .F. + + AAdd( ::aText, HBTextLine():New( cLine, lSoftCR ) ) + +return Self + +//-------------------------------------------------------------------// +// +// Insert a line of text at a defined row +// +METHOD InsertLine( cLine, lSoftCR, nRow ) CLASS XHBEditor + + DEFAULT nRow TO ::nRow + DEFAULT lSoftCR TO .F. + + IF nRow > ::LastRow() + IF Len( cLine ) == 0 + lSoftCR := .F. + ENDIF + ::AddLine( cLine, lSoftCR ) + ELSE + AIns( ::aText, nRow, HBTextLine():New( cLine, lSoftCR ), .T. ) + ENDIF + +return Self + +//-------------------------------------------------------------------// +// +// Remove a line of text +// +METHOD RemoveLine( nRow ) CLASS XHBEditor + DEFAULT nRow TO ::nRow + + ADel( ::aText, nRow, .T. ) + +return Self + +//-------------------------------------------------------------------// +// +// Return line n of text +// +METHOD GetLine( nRow ) CLASS XHBEditor + DEFAULT nRow TO ::nRow + + if nRow <= ::LastRow() .AND. nRow > 0 + if ::lEditAllow .or. Empty(::nTabWidth) + return ::aText[ nRow ]:cText + else + return HB_TabExpand(::aText[ nRow ]:cText, ::nTabWidth) + endif + else + return "" + endif + +Return Self + +//-------------------------------------------------------------------// +// +// Delete text from cursor to end of line. +// +METHOD DelTextRight( nRow ) CLASS XHBEditor + DEFAULT nRow TO ::nRow + + IF !::lEditAllow + Return Self + ENDIF + + if nRow > 0 .AND. nRow <= ::LastRow() + ::lChanged := .T. + ::aText[ nRow ]:cText := Stuff( ::aText[ nRow ]:cText, ::nCol, ::LineLen(nRow) - ::nCol+1,"") + ::RefreshLine() + endif + +return Self + +//-------------------------------------------------------------------// +// +// Delete a word to the right of cursor. +// +METHOD DelWordRight() CLASS XHBEditor + +LOCAL nCol,nCutCol +LOCAL nSpacesPre,cText + + nCutCol := 0 + nCol := ::nCol + + IF !::lEditAllow + Return Self + ENDIF + + ::lChanged :=.T. + + nSpacesPre := 0 + cText := SubStr(::aText[ ::nRow ]:cText,nCol) + + do While .T. + if Left( cText,1 )== " " .AND. Len( cText ) > 0 + cText := SubStr( cText, 2 ) + nSpacesPre++ + else + exit + endif + Enddo + + do While nCutCol <= 1 .AND. nCol < ::LineLen(::nRow) -1 + nCutCol := At(" ",SubStr(::aText[ ::nRow ]:cText,nCol) ) + if nCutCol <= 1 .AND. nCol < ::LineLen( ::nRow )-1 + nCol++ + elseif nCutCol <= 1 .AND. nCol >= ::LineLen( ::nRow ) + nCutCol := Len(SubStr(::aText[::nRow]:cText,::nCol,nCol-::nCol)) + exit + endif + Enddo + + + if nCutCol == 0 .AND. ::LineLen( ::nRow ) >= ::nCol + nCutCol := ::LineLen( ::nRow ) - ::nCol + 1 + endif + + if nCutCol > 0 + + ::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText,::nCol,+nSpacesPre+nCutCol," ") + + if ::lWordWrap .AND. ::aText[ ::nRow ]:lSoftCR + ::SplitLine( ::nRow ) + else + ::aText[::nRow]:lSoftCR := .F. + endif + + endif + +return Self + +//-------------------------------------------------------------------// +// behaviour. +// +METHOD ReformParagraph() CLASS XHBEditor +LOCAL nRow +LOCAL cHardCR := hb_eol() +LOCAL cSoftCR := chr(141) +chr(10) + + IF !::lEditAllow + Return Self + ENDIF + + IF ::LastRow() > 0 + + ::lChanged :=.T. + + FOR nRow := 1 TO ::LastRow() + + ::aText[ nRow ]:cText := StrTran(::aText[ nRow ]:cText, cSoftCR, "") + ::aText[ nRow ]:lSoftCR := .f. + + IF At( cHardCR, ::aText[ nRow ]:cText ) != 0 + EXIT + ENDIF + + NEXT + + ENDIF + +Return Self +//-------------------------------------------------------------------// + +METHOD GotoLine( nRow ) CLASS XHBEditor + LOCAL lRefresh := .f. + + IF nRow > 0 .AND. nRow <= ::LastRow() + + // I need to move cursor if is past requested line number and if requested line is + // inside first screen of text otherwise ::nFirstRow would be wrong + // + IF nRow < ::nFirstRow + ::nFirstRow := nRow + lRefresh := .t. + + ELSEIF nRow - ::nFirstRow >= ::nNumRows + ::nFirstRow := Max( 1, nRow - ::nNumRows + 1 ) + lRefresh := .t. + ENDIF + + ::nRow := Max(1, Min( nRow, ::LastRow() ) ) + + if lRefresh + ::RefreshWindow() + endif + + ::SetPos( ::nTop + nRow - ::nFirstRow, ::nLeft + ::nCol - ::nFirstCol ) + ENDIF + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD GotoCol( nCol ) CLASS XHBEditor + + IF nCol >= 1 + + // 2006/JUL/21 E.F. - Clipper allow cursor movement to left/right into + // line, with or without chars. + // Note: ::nWordWrapCol can be different than ::nNumCols if user has + // informed nLineLength > 0. + nCol := Max( 1, Min( nCol, Max(::nNumCols,::nWordWrapCol+1) ) ) + + // I need to move cursor if is past requested line number and if requested line is + // inside first screen of text otherwise ::nFirstRow would be wrong + // + IF nCol < ::nFirstCol + ::nFirstCol := nCol + ::RefreshWindow() + ELSEIF nCol - ::nFirstCol >= ::nNumCols + ::nFirstCol := Max( 1, nCol - ::nNumCols + 1 ) + ::RefreshWindow() + ENDIF + ::nCol := nCol + ::SetPos( ::Row(), ::nLeft + nCol - ::nFirstCol ) + ENDIF + +RETURN Self + +//-------------------------------------------------------------------// + +METHOD GotoPos( nRow, nCol, lRefresh ) CLASS XHBEditor + + DEFAULT lRefresh TO .F. + + dispbegin() // to minimize flicker + + if nRow > 0 .AND. nRow <= ::LastRow() + // I need to move cursor if is past requested line number and if requested line is + // inside first screen of text otherwise ::nFirstRow would be wrong + // + IF nRow < ::nFirstRow + ::nFirstRow := nRow + lRefresh := .T. + ELSEIF nRow - ::nFirstRow >= ::nNumRows + ::nFirstRow := Max(1, nRow - ::nNumRows + 1 ) + lRefresh := .T. + ENDIF + ::nRow := nRow + ENDIF + + IF nCol >= 1 + + // 2006/JUL/21 E.F. - Clipper allow cursor movement to left/right into + // line, with or without chars. + // Note: ::nWordWrapCol can be different than ::nNumCols if user has + // informed nLineLength > 0 + nCol := Max( 1, Min( nCol, Max(::nNumCols,::nWordWrapCol+1) ) ) + + + // I need to move cursor if is past requested line number and if requested line is + // inside first screen of text otherwise ::nFirstRow would be wrong + IF nCol < ::nFirstCol + ::nFirstCol := nCol // to left scroll + lRefresh := .T. + ELSEIF nCol - ::nFirstCol >= ::nNumCols + ::nFirstCol := Max( 1, nCol - ::nNumCols + 1 ) + lRefresh := .T. + ENDIF + ::nCol := nCol + ENDIF + + dispend() + + IF lRefresh + ::RefreshWindow() + ENDIF + ::SetPos( ::nTop + nRow - ::nFirstRow, ::nLeft + nCol - ::nFirstCol ) + +RETURN Self + +//-------------------------------------------------------------------// +// +// Rebuild a long line from multiple short ones ( wrapped at soft CR ) +// +//-------------------------------------------------------------------// + +/* +*STATIC function GetParagraph( oSelf, nRow ) +* +* LOCAL cLine := "" +* +* do while oSelf:aText[ nRow ]:lSoftCR +* cLine := cline + oSelf:aText[ nRow ]:cText +* // I don't need to increment nRow since I'm removing lines, ie line n is +* // a different line each time I add it to cLine +* oSelf:RemoveLine( nRow ) +* IF Len( cLine ) > 0 .and. cLine[ -1 ] != " " +* cLine += " " +* ENDIF +* enddo +* +* // Last line, or only one line +* // +* cLine += oSelf:aText[ nRow ]:cText +* oSelf:RemoveLine( nRow ) // this is where array error occurs IF final line of text is allowed to have :lSoftCR +* +*return cLine +*/ + +STATIC function GetParagraph( oSelf, nRow ) + + LOCAL cLine := "" + // V@ + do while nRow <= oSelf:LastRow() .AND. ValType( oSelf:aText[ nRow ]:lSoftCR ) == 'L' .and. oSelf:aText[ nRow ]:lSoftCR + cLine += oSelf:aText[ nRow ]:cText + oSelf:RemoveLine( nRow ) + if oSelf:LastRow() <= 0 // V@ + exit + endif + //GAD This is not needed and will corrupt long lines that do not have any spaces with wordwrap on. +/* IF Len( cLine ) > 0 .and. cLine[ -1 ] != " " + cLine += " " + ENDIF +*/ + enddo + + // Last line, or only one line + // + if nRow <= oSelf:LastRow() .AND. oSelf:LastRow() > 0 // V@ + cLine += oSelf:aText[ nRow ]:cText + oSelf:RemoveLine( nRow ) // this is where array error occurs IF final line of text is allowed to have :lSoftCR + endif + +return cLine + +//-------------------------------------------------------------------// +// +// If a line of text is longer than nWordWrapCol divides it into multiple lines, +// Used during text editing to reflow a paragraph +// +//-------------------------------------------------------------------// + +METHOD SplitLine( nRow ) CLASS XHBEditor + LOCAL nFirstSpace, nCurSpace + LOCAL cLine + LOCAL cSplittedLine + LOCAL nStartRow + LOCAL nPosInWord + + // Do something only if Word Wrapping is on + IF .NOT. ::lWordWrap // .OR. ( ::LineLen( nRow ) <= ::nWordWrapCol ) + RETURN Self + ENDIF + + ::lRightScroll := .F. // must be .F. within this Method + + // Move cursor to next line if you will move the word which I'm over to next line + // ie, since word wrapping happens at spaces if first space is behind cursor + + // special case; if the character(s) at the end of the line are spaces, we must just + // create a blank line. + // + cLine := ::GetLine( nRow ) + + // count words up to the word containing the cursor. + // + nFirstSpace := 0 + nCurSpace := At( " ", cLine ) + DO WHILE nCurSpace <= ::nCol .and. nCurSpace > 0 + nFirstSpace := nCurSpace + nCurSpace := hb_At( " ", cLine, nCurSpace + 1 ) + ENDDO + + // and see at what point in that line the cursor is. + // remember that nFirstSpace is zero based, and pointing to one space + // before the current word. + // + nPosInWord := IIF( ::nCol > nFirstSpace, ::nCol - nFirstSpace, 1 ) + + nStartRow := nRow + cLine := GetParagraph( Self, nRow ) + + do while Len( cLine ) >= ::nWordWrapCol + // Added + 1 because it is possible that line ends when there is a space + // next to nWordWrapCol + // + nFirstSpace := ::nWordWrapCol + 1 + + // Split line at fist space before current position + // + do while nFirstSpace > 1 .and. !( cLine[nFirstSpace] == " " ) + nFirstSpace -- + enddo + + // If there is a space before beginning of line split there + // + if nFirstSpace > 1 + cSplittedLine := Left( cLine, nFirstSpace ) + else + // Changed -- now splits line at the nWordWrapCol when no space! The cursor position is not reliable! + // This avoids error if the line has NO SPACES! Without this modif. code enters infinite loop on wrap + // Note that cursor postioning when wrapping lines that have NO space is funky due to MovetoNextLine() problems + // + // Old method was: else split at current cursor position + // cSplittedLine := Left( cLine, ::nCol - 1 ) + + // 2006/07/19 - E.F. - Changed cut point at witdh of line to maintain. + // amount of chars same as Clipper. + // + //cSplittedLine := Left( cLine, ::nWordWrapCol ) + cSplittedLine := Left( cLine, Min(::nWordWrapCol+1,::nNumCols) ) + + endif + + // A necessity because xHarbour does not insert the SoftCarriage and + // then we are unable to keep trace of where the line break was while + // reformatting + // +//GAD + if !( right( cSplittedLine, 1 ) == " " ) .AND. nFirstSpace > 1 + // 2006/JUL/21 - E.F. - Added condition to not stay out of max columns. + if Len(cSplittedLine) < ::nNumCols + cSplittedLine += " " + endif + endif + // We must not trim the line as split occurs next to a space + // + ::InsertLine( cSplittedLine, .T., nStartRow++ ) + cLine := Substr( cLine, Len( cSplittedLine ) + 1 ) + enddo + + // insert EVEN an empty row (it will be added at bottom) + // I have to recheck if trim is viable here ??? + // + + // 2006/JUL/21 - E.F. Only insert a line in any circunstancies. + // + IF nStartRow+1 <= ::LastRow() + IF ::LineLen( nStartRow+1 ) == 0 .OR. Len( alltrim(cLine) ) > 0 + ::InsertLine( Trim(cLine), .F., nStartRow ) + ENDIF + ELSE + ::InsertLine( Trim(cLine), .F., nStartRow ) + ENDIF + + // re-count words and see where current word has gone. + cLine := ::GetLine( nRow ) + + IF Len( cLine ) < ::nCol + nCurSpace := At( " ", cLine ) + // stop when word count has matched OR when nCol is passed (all stay in current line). + DO WHILE nCurSpace > 0 .and. nCurSpace <= ::nCol + nCurSpace := hb_At( " ", cLine, nCurSpace + 1 ) + ENDDO + + // next line? + IF nCurSpace == 0 + nRow ++ + //fake border new. + ::nFirstCol := 1 + ::GotoPos( nRow, nPosInWord, .T. ) + ELSEIF nCurSpace == ::nCol + nRow ++ + ::GotoPos( nRow, 1, .T. ) + ELSE + ::RefreshWindow() + ENDIF + ELSE + ::RefreshWindow() + ENDIF + ::lRightScroll := .T. // set at beginning of if/endif -- must be .F. in SplitScreen() + +RETURN Self + +//-------------------------------------------------------------------// +// +// Utility Methods +// +//-------------------------------------------------------------------// +// +// This in an empty method which can be used by classes subclassing HBEditor to be able +// to handle particular keys. +// +//-------------------------------------------------------------------// + +METHOD KeyboardHook() CLASS XHBEditor + +return Self + +//-------------------------------------------------------------------// +// +// There are no more keys to handle. Can I do something for you? +// + +METHOD IdleHook() CLASS XHBEditor + +return Self + + +//-------------------------------------------------------------------// + +METHOD SetColor( cColorString ) CLASS XHBEditor + + local cOldColor := ::cColorSpec + + if cColorString != nil + ::cColorSpec := cColorString + endif + +return cOldColor + +//-------------------------------------------------------------------// + +METHOD Hilite() CLASS XHBEditor + + local cEnhanced := "" + + // Swap CLR_STANDARD and CLR_ENHANCED + cEnhanced += __StrToken( ::cColorSpec, 2, "," ) + "," + cEnhanced += __StrToken( ::cColorSpec, 1, "," ) + + ::SetColor( cEnhanced + Right( ::cColorSpec, Len( ::cColorSpec ) - Len( cEnhanced ) ) ) + +return Self + +//-------------------------------------------------------------------// + +METHOD DeHilite() CLASS XHBEditor + + local cStandard := "" + + // Swap CLR_STANDARD and CLR_ENHANCED back to their original position inside cColorSpec + cStandard += __StrToken( ::cColorSpec, 2, "," ) + "," + cStandard += __StrToken( ::cColorSpec, 1, "," ) + + ::SetColor( cStandard + Right( ::cColorSpec, Len( ::cColorSpec ) - Len( cStandard ) ) ) + +return Self + +//-------------------------------------------------------------------// + +METHOD SetPos( nRow, nCol ) CLASS XHBEditor + + default nRow to ::nPhysRow + default nCol to ::nPhysCol + + ::nPhysRow := nRow + ::nPhysCol := nCol + + SetPos( ::nPhysRow, ::nPhysCol ) + +return ::nPhysRow + +//-------------------------------------------------------------------// +// +// Changes lInsert value and insertion / overstrike mode of editor +// +METHOD InsertState( lInsState ) CLASS XHBEditor + + // 2006/JUL/22 - E.F. - Insert only in edit mode. + IF ::lEditAllow .AND. ISLOGICAL( lInsState ) .AND. ::lInsert != lInsState + + ::lInsert := lInsState + + // Redundant, but useful if ::lInsert is used as class DATA + SET( _SET_INSERT, lInsState ) + + if lInsState + Setcursor( SC_INSERT ) + else + Setcursor( SC_NORMAL ) + endif + + ::DisplayInsert( lInsState ) + + ENDIF + +return Self + +//-------------------------------------------------------------------// +// 2006/JUL/15 - E.F. - Display "" message +// +METHOD DisplayInsert( lInsert ) CLASS XHBEditor + LOCAL nCurRow, nCurCol, nCursor + + if Set( _SET_SCOREBOARD ) + + nCurCol := Col() + nCurRow := Row() + nCursor := SetCursor(SC_NONE) + + if lInsert + IF ::cInsLabel == NIL + ::cInsLabel := SaveScreen(0,60,0,67 ) + ENDIF + @ 0,60 say "" + else + IF ::cInsLabel != NIL + RestScreen(0,60,0,67, ::cInsLabel ) + ::cInsLabel := NIL + ENDIF + endif + + SetCursor(nCursor) + SetPos( nCurRow,nCurCol ) + + endif + + +Return NIL + +//-------------------------------------------------------------------// +// +// Converts an array of text lines to a String +// +METHOD GetText( lSoftCr ) CLASS XHBEditor + + LOCAL cString := "", cSoft:= "" + LOCAL cEOL := hb_eol() + + + DEFAULT lSoftCr TO .F. + +IF ::LastRow() > 0 + + if lSoftCr + cSoft:= CHR( 141 ) + CHR( 10 ) + endif + + if ::lWordWrap + AEval( ::aText, {| cItem | cString += cItem:cText + iif( cItem:lSoftCR, cSoft, cEOL )},,::LastRow() - 1) + else + AEval( ::aText, {| cItem | cString += cItem:cText + cEOL},, ::LastRow() - 1) + endif + + // Last line does not need a cEOL delimiter + cString += ::aText[ ::LastRow() ]:cText + +ENDIF + +return cString + + +//-------------------------------------------------------------------// +// +// Returns the text selection in a string +// +METHOD GetTextSelection( lSoftCr ) CLASS XHBEditor + + LOCAL cString := "" + LOCAL cSoft := "" + LOCAL cEOL := hb_eol() + LOCAL nRowSelStart + LOCAL nRowSelEnd + LOCAL nI + + DEFAULT lSoftCr TO .F. + + if !::lSelActive + Return cString + endif + + if lSoftCr + cSoft:= CHR( 141 ) + CHR( 10 ) + endif + + if ::nRowSelStart > 0 .and. ::nRowSelEnd > 0 + + if ::nRowSelStart > ::nRowSelEnd + nRowSelStart := ::nRowSelEnd + nRowSelEnd := ::nRowSelStart + else + nRowSelStart := ::nRowSelStart + nRowSelEnd := ::nRowSelEnd + endif + + FOR nI := nRowSelStart TO nRowSelEnd + cString += ::aText[ nI ]:cText + iif(::lWordWrap .and. ::aText[ nI ]:lSoftCR, cSoft, cEOL ) + NEXT + endif + + if ::nColSelStart > 0 .and. ::nColSelEnd > 0 + cString += SubStr( ::aText[ ::nRow ]:cText, ::nColSelStart, ::nColSelEnd - ::nColSelStart + 1 ) + iif(::lWordWrap .and. ::aText[ ::nRow ]:lSoftCR, cSoft, cEOL ) + endif + +Return cString + +//-------------------------------------------------------------------// +// +// Set current selection +// +METHOD SetTextSelection( cAction, nCount ) CLASS XHBEditor + + + if !::lSelActive + + ::lSelActive := .T. + + if cAction == "ALL" + + ::nRowSelStart := 1 + ::nRowSelEnd := ::LastRow() + ::nColSelStart := ::nColSelEnd := 0 + ::RefreshWindow() + + elseif cAction == "ROW" + + ::GotoCol( 1 ) + + if nCount > 0 // Shift-Down + ::nRowSelStart := ::nRow + ::nRowSelEnd := ::nRowSelStart + ::RefreshLine() + if ::nRow < ::LastRow() + ::GotoLine( ::nRow + 1 ) + endif + + elseif nCount < 0 // Shift-UP + if ::nRow > 1 + ::GotoLine( ::nRow - 1 ) + endif + ::nRowSelStart := ::nRow + ::nRowSelEnd := ::nRowSelStart + ::RefreshLine() + endif + + elseif cAction == "COL" + + if nCount > 0 // Shift Right + if ::nCol < ::nWordWrapCol+1 + ::GotoCol( ::nCol + 1) + if ::nColSelStart==0 + ::nColSelRow := ::nRow + ::nColSelStart := Max(1,::nCol-1) + endif + ::nColSelEnd := Max(1,::nCol-1) + ::RefreshLine(.T.) + endif + elseif nCount < 0 // Shift Left + if ::nCol > 1 + if ::nColSelStart=0 .and. ::nColSelEnd=0 + ::nColSelEnd := ::nColSelStart := ::nCol + endif + ::GotoCol( ::nCol - 1 ) + ::nColSelEnd := Max(::nColSelEnd,::nCol) + ::nColSelRow := ::nRow + ::nColSelStart := ::nCol + else + ::nColSelRow := ::nColSelStart := ::nColSelEnd := 0 + ::lSelActive := .F. + endif + ::RefreshLine(.T.) + endif + + elseif cAction == "END" + + if ::nColSelStart==0 + ::nColSelRow := ::nRow + ::nColSelStart := Max(1,::nCol-1) + endif + ::End() + ::nColSelEnd := Max(1,::nCol-1) + ::RefreshLine(.T.) + + elseif cAction == "HOME" + + ::nColSelRow := ::nRow + ::nColSelEnd := ::nCol + ::nColSelStart := 1 + ::GotoCol( 1 ) + ::RefreshLine(.T.) + + endif + + else + + if cAction == "ALL" + + ::nRowSelStart := 1 + ::nRowSelEnd := ::LastRow() + ::nColSelStart := ::nColSelEnd := 0 + ::RefreshWindow() + + elseif cAction == "ROW" + + if nCount > 0 // Shift-Down + + if ::nRowSelStart == 0 + ::nRowSelStart := ::nRow + elseif ::nRowSelEnd > ::nRow + ::Clrtextselection() + ::lSelActive := .t. + ::nRowSelEnd := ::nRowSelStart := ::nRow -1 + endif + + if ::nRow >= ::nRowSelStart .and. ::nRow <= ::nRowSelEnd + if ::nColSelStart > 0 .and. ::nColSelEnd > 0 + ::nRowSelStart := ::nRow + else + ::nRowSelStart := ::nRow+1 + endif + else + ::nRowSelEnd := ::nRow + endif + + ::nColSelStart := ::nColSelEnd := 0 + + if ::nRowSelEnd == ::LastRow() + //::nRowSelEnd := ::LastRow()-1 + /* 2006/SEP/17 - E.F. - At this point we need add a new line + to be able to select the last row. + */ + if !Empty( ::aText[::nRowSelEnd]:cText ) + ::AddLine() + else + ::nRowSelEnd := ::LastRow()-1 + endif + endif + ::RefreshLine() + if ::nRow < ::LastRow() + ::GotoLine( ::nRow + 1 ) + endif + + elseif nCount < 0 // Shift-Up + + // if columns was already selected before... + // + if (::nRowSelStart == 0 .and. ::nRowSelEnd==0) .or.; + (::nRowSelEnd - ::nRowSelStart == 1 .and.; + ::nColSelStart > 0 .and. ::nColSelEnd > 0) + + ::nColSelStart := ::nColSelEnd := 0 + ::nRowSelStart := ::nRow + ::nRowSelEnd := ::nRow + ::RefreshLine() + + elseif ::nRowSelEnd - ::nRowSelStart > 1 .and.; + ::nColSelStart > 0 .and. ::nColSelEnd > 0 + + ::Clrtextselection() + ::lSelActive :=.t. + ::nRowSelEnd := ::nRow-1 + ::nRowSelStart := ::nRowSelEnd + ::RefreshLine() + + endif + + + if ::nRow > 1 + ::GotoLine( ::nRow - 1 ) + endif + + if ::nRow >= ::nRowSelStart .AND. ::nRow <= ::nRowSelEnd + if ::nRowSelEnd - ::nRowSelStart > 0 + ::nRowSelEnd := ::nRow - 1 + else + ::nRowSelEnd := ::nRow + endif + else + ::nRowSelStart := ::nRow + endif + + if ::nRow==1 .and. ::nRowSelStart == 1 .and. ::nRowSelEnd == 1 + ::Clrtextselection() + endif + + ::RefreshLine() + + endif + + elseif cAction == "COL" + + if nCount > 0 // Shift-Right + if ::nCol < ::nWordWrapCol+1 + ::GotoCol( ::nCol + 1) + if ::nColSelStart==0 + ::nColSelRow := ::nRow + ::nColSelStart := Max(1,::nCol-1) + endif + ::nColSelEnd := Max(::nColSelStart,::nCol-1) + if ::nColSelStart == ::nColSelEnd + ::nColSelStart := ::nColSelEnd := Max(1,::nCol-1) + ::nColSelRow := 0 + endif + ::RefreshLine(.T.) + endif + + elseif nCount < 0 // Shift-Left + + if ::nCol > 1 + ::GotoCol( ::nCol - 1 ) + if ::nColSelEnd==0 + ::nColSelRow := ::nRow + ::nColSelEnd := Max(::nColSelEnd,::nCol) + endif + if ::nColSelStart <=::nCol-1 + ::nColSelEnd := Min(::nColSelEnd,::nCol-1) + else + ::nColSelStart := Max(1,::nCol) + endif + if ::nCol=1 .and. ::nColSelStart == ::nColSelEnd + ::lSelActive := .F. + endif + ::RefreshLine(.T.) + else + if ::nColSelEnd == ::nColSelStart + ::nColSelStart := ::nColSelEnd := 0 + ::nColSelRow := 0 + endif + ::lSelActive := .F. + endif + + endif + + elseif cAction == "END" + + if ::nColSelStart==0 + ::nColSelStart := Max(1,::nCol-1) + endif + ::End() + ::nColSelEnd := Max(1,::nCol-1) + ::RefreshLine(.T.) + + elseif cAction == "HOME" + + ::nColSelEnd := ::nCol + ::nColSelStart := 1 + ::GotoCol( 1 ) + ::RefreshLine(.T.) + + endif + + endif + +return nil + +//-------------------------------------------------------------------// +// +// Clear current selection +// +METHOD ClrTextSelection() CLASS XHBEditor + + if ::lSelActive + ::lSelActive := .F. + ::nRowSelStart := ::nRowSelEnd := 0 + ::nColSelRow := 0 + ::nColSelStart := ::nColSelEnd := 0 + ::RefreshWindow() + endif + +Return nil + +METHOD DelText() CLASS XHBEditor + + IF !::lEditAllow + Return self + ENDIF + + // 2006/SEP/17 - E.F. - changed to ::top() to avoid cursor out of bound. + //::Gotop() + ::Top() + + ::aText := {} + + // 2006/JUL/22 - E.F. - There is no need to add line here. + // See K_ASCII() method. + // AAdd( ::aText, HBTextLine():New() ) + + ::lChanged := .T. + + ::RefreshWindow() + +return Self + + +METHOD DelTextSelection() CLASS XHBEditor + + LOCAL nRowSelStart + LOCAL nRowSelEnd + LOCAL nI + LOCAL cText + + if !::lEditAllow + Return Self + endif + + if ::lSelActive + + // if only rows are selected + if ::nRowSelStart > 0 .and. ::nRowSelEnd > 0 + + if ::nRowSelStart > ::nRowSelEnd + nRowSelStart := ::nRowSelEnd + nRowSelEnd := ::nRowSelStart + else + nRowSelStart := ::nRowSelStart + nRowSelEnd := ::nRowSelEnd + endif + + ::lChanged := .T. + + for nI := nRowSelStart to nRowSelEnd + ::RemoveLine( nRowSelStart ) + next + + ::nRow := nRowSelStart + + if empty( ::aText ) + ::DelText() + else + ::GoToPos( max(1,nRowSelStart) , 1 ) + endif + + ::ClrTextSelection() + + else + + if ::nColSelStart > 0 .and. ::nColSelEnd > 0 +// if empty( nRowSelStart ) +// nRowSelStart := ::nColSelRow +// endif + cText := ::aText[::nRow]:cText + ::aText[::nRow]:cText := Stuff( cText, ::nColSelStart, ::nColSelEnd - ::nColSelStart + 1, "" ) + ::RefreshLine() + ::GoToPos( ::nRow, max(1,::nColSelStart ) ) + ::nColSelStart := ::nColSelEnd := 0 + ::lChanged := .T. + if empty( ::aText ) + ::DelText() + endif + endif + + endif + // 3/03/2008 8:26a.m. added next 4 lines to fix array out of bounds RTL + if ::nRow > ::LastRow() + ::Addline("", .F. ) + ::GoBottom() + endif + + endif + +Return Self + +METHOD AddText( cString, lAtPos ) CLASS XHBEditor + + LOCAL aTmpText + LOCAL nLines + LOCAL i + LOCAL nAtRow + LOCAL lSaveIns + + if !::lEditAllow + Return Self + endif + + + if !empty( cString ) + + aTmpText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, nil ) ) + nLines := Len( aTmpText ) + nAtRow := ::nRow + lSaveIns := ::lInsert + + if !lSaveIns + ::InsertState( .T. ) + endif + + DEFAULT lAtPos TO .F. + + if !lAtPos .or. ( nAtRow > ::LastRow() ) + for i := 1 to nLines + aadd( ::aText, aTmpText[ i ] ) + next + else + nAtRow-- + for i := 1 to nLines + AIns( ::aText, nAtRow+i, aTmpText[ i ], .T. ) + next + if nLines > 0 + // ::RemoveLine(nAtRow+nLines) + endif + endif + + if !lSaveIns + ::InsertState( .F. ) + endif + + ::lChanged := .T. + ::RefreshWindow() + + endif + +return Self + +METHOD GetTextIndex() CLASS XHBEditor + LOCAL nPos := 0 + LOCAL oItem, nCount + LOCAL nEol := Len( hb_eol() ) + + // Using outer IF strategy to be more fast + IF ::lWordWrap + FOR nCount := 1 TO ::nRow - 1 + oItem := ::aText[ nCount ] + nPos += iif( oItem:lSoftCR, 0 , nEol ) + Len( oItem:cText ) + NEXT + ELSE + FOR nCount := 1 TO ::nRow - 1 + oItem := ::aText[ nCount ] + nPos += Len( oItem:cText ) + nEol + NEXT + ENDIF + + nPos += ::nCol +RETURN nPos + +//-------------------------------------------------------------------// + +METHOD LoadText( cString ) CLASS XHBEditor + + ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, nil ) ) + + if ::LastRow() == 0 + AAdd( ::aText, HBTextLine():New() ) + endif + + ::lChanged := .F. + ::GoTop() + +Return Self + +//-------------------------------------------------------------------// + +METHOD LoadFile( cFileName ) CLASS XHBEditor + + local cString := "" + + if File( cFileName ) + ::cFile := cFileName + cString := MemoRead( cFileName ) + endif + + ::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, nil ) ) + + if ::LastRow() == 0 + AAdd( ::aText, HBTextLine():New() ) + endif + + ::lChanged := .F. + ::GoTop() + +return Self + +//-------------------------------------------------------------------// +// +// Saves file being edited, if there is no file name does nothing, returns .T. if OK +// +METHOD SaveFile() CLASS XHBEditor + + local cString + + if !Empty( ::cFile ) + cString := ::GetText() + ::lChanged := !MemoWrit( ::cFile, cString ) + return !::lChanged + endif + +Return .F. + +//-------------------------------------------------------------------// +// +// Utility Functions +// +//-------------------------------------------------------------------// +// +// Returns EOL char ( be it either CR or LF or both ) +// +STATIC function WhichEOL( cString ) + + LOCAL nCRPos := At( Chr( 13 ), cString ) + LOCAL nLFPos := At( Chr( 10 ), cString ) + + if nCRPos > 0 .AND. nLFPos == 0 + return Chr( 13 ) + + elseif nCRPos == 0 .AND. nLFPos > 0 + return Chr( 10 ) + + elseif nCRPos > 0 .AND. nLFPos == nCRPos + 1 + return Chr( 13 ) + Chr( 10 ) + + endif + +return hb_eol() + +//-------------------------------------------------------------------// +// +// Converts a string to an array of strings splitting input string at EOL boundaries +// +STATIC function Text2Array( cString, nWordWrapCol ) + + LOCAL cLine + LOCAL aArray + LOCAL cEOL + LOCAL nEOLLen + LOCAL nRetLen + LOCAL ncSLen + LOCAL nFirstSpace + LOCAL cSplittedLine + LOCAL nTokPos := 0 + LOCAL lTokenized:=.f. + LOCAL cSoftCR := CHR(141)+CHR(10) + + // 2005/JUL/19 - E.F. - SoftCR must be removed before convert string to + // array. It will be treated by HBEditor. + IF cSoftCR $ cString + cString := StrTran( cString, cSoftCR, "" ) + ENDIF + + + aArray := {} + + cEOL := WhichEOL( cString ) + nEOLLen := Len( cEOL ) + + // __StrTkPtr() needs that string to be tokenized be terminated with a token delimiter + if ! Right( cString, Len( cEOL ) ) == cEOL + cString += cEOL + //GAD so we don't add a blank line by accident at the end of this. + lTokenized:=.t. + endif + + nRetLen := 0 + ncSLen := Len( cString ) + + // If cString starts with EOL delimiters I have to add empty lines since __StrTkPtr + // gives back _next_ token and would skip these first EOL delimiters + do while SubStr( cString, nTokPos + 1, nEOLLen ) == cEOL + AAdd( aArray, HBTextLine():New( cLine, .F. ) ) + nTokPos += nEOLLen + nRetLen += nEOLLen + enddo + + do while nRetLen < ncSLen + /* TOFIX: Note that __StrToken is not able to cope with delimiters longer than one char */ + // Dos - OS/2 - Windows have CRLF as EOL + if nEOLLen > 1 + cLine := StrTran( __StrTkPtr( @cString, @nTokPos, cEOL ), SubStr( cEOL, 2 ), "" ) + else + cLine := __StrTkPtr( @cString, @nTokPos, cEOL ) + endif + nRetLen += Len( cLine ) + nEOLLen + + if HB_IsNumeric( nWordWrapCol ) .AND. Len( cLine ) > nWordWrapCol + do while .T. + // Split line at nWordWrapCol boundary + if Len( cLine ) > nWordWrapCol + nFirstSpace := RAt( " ", Left( cLine, nWordWrapCol + 1 ) ) + if nFirstSpace > 1 + cSplittedLine := Left( cLine, nFirstSpace ) + cLine := SubStr( cLine, nFirstSpace + 1 ) + else + cSplittedLine := Left( cLine, nWordWrapCol ) + // 2006/07/19 - E.F. Changed cut point of second split. + //cLine := SubStr( cLine, nWordWrapCol + 1 ) + cLine := SubStr( cLine, Len(cSplittedLine) + 1 ) + endif + AAdd( aArray, HBTextLine():New( cSplittedLine, .T. ) ) + else + // remainder of line is shorter than split point + // 2006/JUL/21 - E.F. Only add a new line if cLine is not empty. + // + IF Len( cLine ) > 0 + AAdd( aArray, HBTextLine():New( cLine, .F. ) ) + ENDIF + // Done. + exit + endif + + enddo + else + AAdd( aArray, HBTextLine():New( cLine, .F. ) ) + endif + + enddo + //If string ends with EOL delimeters we have to add it here. + if !lTokenized .AND. right( cString, nEOLLen ) == cEOL + AAdd( aArray, HBTextLine():New( , .F. ) ) + endif + + +return aArray + +//-------------------------------------------------------------------// +// +// if editing isn't allowed we enter this loop which +// handles only movement keys and discards all the others +// +METHOD BrowseText( nPassedKey, lHandleOneKey ) CLASS XHBEditor + + LOCAL nKey,bKeyBlock + + + default lHandleOneKey TO .F. + + + do while ! ::lExitEdit + + // If I haven't been called with a key already preset, evaluate this key and then exit + if nPassedKey == NIL + + if NextKey() == 0 + ::IdleHook() + endif + + nKey := InKey( 0 ) + else + nKey := nPassedKey + endif + + if ( bKeyBlock := Setkey( nKey ) ) != NIL + Eval( bKeyBlock, ::ProcName, ::ProcLine, "", Self ) + Loop + endif + + // ******* modified to add exit with K_LEFT when in non-edit mode + if nKey == K_ESC .or. nkey == K_CTRL_W + ::lExitEdit := .T. + + else + ::MoveCursor( nKey ) + /* 02/09/2004 - + If I'm on a readonly editor don't call KeyboardHook() because + it calls HandleUserKey() which calls Edit() which sees this is + a readonly editor and calls again BrowseText() which.., + if ! oSelf:MoveCursor( nKey ) + oSelf:KeyboardHook( nKey ) + endif + */ + endif + + // If I want to handle only one key and then exit... + if lHandleOneKey + exit + endif + + enddo + +return nil + +//-------------------------------------------------------------------//