fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
b1ded1ebb493aedc4f62f71300aeb99ddbabe8bd
harbour-core/harbour/source/rtl/teditor.prg
Mindaugas Kavaliauskas dde57c5c70 2008-12-18 05:02 UTC+0200 Mindaugas Kavaliauskas (dbtopas/at/dbtopas.lt) 
* include/hbclass.ch
  * include/hbcomp.ch
  * include/hberrors.h
  * include/hbgenerr.c
  * include/hbmain.c
  * include/hbopt.c
    + PCode optimizations:
        1) Self := QSELF(), Self:method -> QSELF():method
        2) Declared, but unused variables are removed from code
      These optimizations are enabled if jump optimizations are enabled.

    + added recursive pcode tree tracer. It is capable to generate new
      warning: Variable %s is assigned, but not used. 
      Warning is not generated in these cases:
        1) unoptimal Self := QSELF() pcode [generated by preprocessor rules]
        2) if variable name starts with '_nowarn_'. This allows to 
           suppress warning in case unoptimal pcode is generated by 
           preprocessor rules
        3) assigned value is NIL. This let us force garbage collection
           using oVar := NIL
      Warning has warning level 3.
      ; NOTE: if you are using -w3 -es2 in makefiles, you'll need to fix your 
              redundant code to compile the project

  * source/rtl/achoice.prg
  * source/rtl/browse.prg
  * source/rtl/tbrowse.prg
  * source/rtl/teditor.prg
  * source/rtl/tget.prg
  * source/rtl/tgetlist.prg
  * source/rtl/tlabel.prg
  * source/rtl/tmenusys.prg
  * source/rtl/tpersist.prg
  * source/rtl/treport.prg
  * source/debug/dbgtmenu.prg
  * source/debug/debugger.prg
  * source/debug/dbgtobj.prg
    * fixed 'assigned but not used' warnings

  * utils/hbdoc/hbdoc.prg
  * utils/hbdoc/genasc.prg
  * utils/hbdoc/genhpc.prg
  * utils/hbdoc/genhtm.prg
  * utils/hbdoc/genchm.prg
  * utils/hbdoc/genng.prg
  * utils/hbdoc/genos2.prg
  * utils/hbdoc/genrtf.prg
  * utils/hbdoc/gentrf.prg
  * utils/hbdoc/ft_funcs.prg
  * utils/hbmake/hbmake.prg
    * #pragma -w2
    ; NOTE: I've been fixing warnings in utils/hbdoc/* for 2 hours, 
      but only fixed half of files. There are a lot of garbage code here.
      I do not thing this code is working... 
      I used fallback method: restored original files and used -w2
    ; NOTE: hbmake.prg has about 140 unused assignments.
      I've also fallback to -w2, because some of unused code is complex, 
      ex., ASCAN() with block parameters. I'm not using hbmake, and I'm 
      affraid to break something important. 

  * compiler/hbpcode.c
    - removed Ron's copyright on hb_compStrongType(). We do not have this 
      functions in the compiler at all. I guess this text is just a result 
      of .c header copy-paste from xHarbour's hbstrong.c some time ago.
2008-12-18 03:04:50 +00:00

1132 lines
36 KiB
Plaintext
Raw Blame History

/*
* $Id$
*/
/*
* Harbour Project source code:
* Editor Class (base for Memoedit(), debugger, etc.)
*
* Copyright 2000 Maurilio Longo <maurilio.longo@libero.it>
* 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.
*
*/
#include "hbclass.ch"
#include "button.ch"
#include "color.ch"
#include "common.ch"
#include "error.ch"
#include "fileio.ch"
#include "inkey.ch"
#include "setcurs.ch"
CREATE CLASS HBEditor
EXPORTED:
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 ) // 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 LineCount() // Returns number of lines in text.
METHOD GetText() // Returns aText as a string (for MemoEdit())
METHOD display() // Redraw a window
METHOD RefreshLine() // 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 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 ExitState() // Returns ::lExitEdit
METHOD KeyboardHook( nKey ) // 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() // Same as clipper ones, returns ::nPhysRow
METHOD Col() // Same as clipper ones, returns ::nPhysCol
METHOD RowPos() // Returns ::nRow
METHOD ColPos() // Returns ::nCol value
METHOD Saved() // Returns ::lSaved
METHOD Changed() // Returns ::lDirty
METHOD IsWordWrap() // Returns ::lWordWrap
METHOD WordWrapCol() // Returns ::nWordWrapCol
METHOD hitTest( nMRow, nMCol ) // UI control compatible method
MESSAGE RefreshWindow() METHOD display() // for compatibility
METHOD New( cString, nTop, nLeft, nBottom,; // Converts a string to an array of strings splitting input string at EOL boundaries
nRight, lEditMode, nLineLength, nTabSize )
PROTECTED:
VAR cFile AS STRING INIT "" // name of file being edited
VAR aText AS ARRAY INIT {} // array with lines of text being edited
VAR naTextLen AS NUMERIC INIT 0 // number of lines of text inside aText.
VAR nTop AS NUMERIC // boundaries of editor window, without box around
VAR nLeft AS NUMERIC
VAR nBottom AS NUMERIC
VAR nRight AS NUMERIC
VAR nFirstCol AS NUMERIC INIT 1 // FirstCol/Row of current text visible inside editor window
VAR nFirstRow AS NUMERIC INIT 1
VAR nRow AS NUMERIC INIT 1 // Cursor position inside aText (nRow) and inside current line of text (nCol)
VAR nCol AS NUMERIC INIT 1
VAR nPhysRow AS NUMERIC INIT 0 // Hardware cursor position, I cannot rely on Row()/Col() because I could be inside another
VAR nPhysCol AS NUMERIC 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()
VAR nNumCols AS NUMERIC INIT 1 // How many columns / rows can be displayed inside editor window
VAR nNumRows AS NUMERIC INIT 1
VAR lInsert AS LOGICAL INIT .F. // Is editor in Insert mode or in Overstrike one?
VAR nTabWidth AS NUMERIC INIT 8 // Size of Tab chars
VAR lEditAllow AS LOGICAL INIT .T. // Are changes to text allowed?
VAR lSaved AS LOGICAL INIT .F. // True if user exited editor with K_CTRL_W
VAR lWordWrap AS LOGICAL INIT .F. // True if word wrapping is active
VAR nWordWrapCol AS NUMERIC INIT 0 // At which column word wrapping occurs
VAR lDirty AS LOGICAL INIT .F. // .T. if there are changes not saved
VAR lExitEdit AS LOGICAL INIT .F. // .T. if user requested to end Edit() method
VAR cColorSpec AS CHARACTER // Color string used for screen writes
METHOD GetParagraph( nRow )
METHOD BrowseText( nPassedKey )
ENDCLASS
/* -------------------------------------------- */
// Redefines editor window size and refreshes it
METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBEditor
// 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
IF ( ::nRow - ::nFirstRow ) > ::nNumRows
//current row is outide the editor window - display it at the top
::nFirstRow := ::nRow
ENDIF
// FirstCol/Row of current text visible inside editor window
::nFirstCol := 1
// Cursor position inside aText (nRow) and inside current line of text (nCol)
::nCol := 1
// Set cursor upper left corner
::SetPos( ::nTop + ::nRow - ::nFirstRow, ::nLeft )
::display()
RETURN Self
METHOD LoadFile( cFileName ) CLASS HBEditor
LOCAL cString
IF File( cFileName )
::cFile := cFileName
cString := MemoRead( cFileName )
ELSE
cString := ""
ENDIF
::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, NIL ) )
::naTextLen := Len( ::aText )
IF ::naTextLen == 0
AAdd( ::aText, HBTextLine():New() )
::naTextLen++
ENDIF
::lDirty := .F.
::MoveCursor( K_CTRL_PGUP )
RETURN Self
METHOD LoadText( cString ) CLASS HBEditor
::aText := Text2Array( cString, iif( ::lWordWrap, ::nNumCols, NIL ) )
::naTextLen := Len( ::aText )
IF ::naTextLen == 0
AAdd( ::aText, HBTextLine():New() )
::naTextLen++
ENDIF
::lDirty := .F.
::MoveCursor( K_CTRL_PGUP )
RETURN Self
// Saves file being edited, if there is no file name does nothing, returns .T. if OK
METHOD SaveFile() CLASS HBEditor
IF !Empty( ::cFile )
::lDirty := !hb_MemoWrit( ::cFile, ::GetText() )
RETURN !::lDirty
ENDIF
RETURN .F.
// Add a new Line of text at end of current text
METHOD AddLine( cLine, lSoftCR ) CLASS HBEditor
AAdd( ::aText, HBTextLine():New( cLine, lSoftCR ) )
::naTextLen++
RETURN Self
// Insert a line of text at a defined row
METHOD InsertLine( cLine, lSoftCR, nRow ) CLASS HBEditor
::AddLine()
AIns( ::aText, nRow )
::aText[ nRow ] := HBTextLine():New( cLine, lSoftCR )
RETURN Self
// Remove a line of text
METHOD RemoveLine( nRow ) CLASS HBEditor
ADel( ::aText, nRow )
ASize( ::aText, --::naTextLen )
RETURN Self
// Return line n of text
METHOD GetLine( nRow ) CLASS HBEditor
RETURN iif( nRow <= ::naTextLen .AND. nRow > 0, ::aText[ nRow ]:cText, "" )
// Return text length of line n
METHOD LineLen( nRow ) CLASS HBEditor
RETURN Len( ::aText[ nRow ]:cText )
// Converts an array of text lines to a String
METHOD GetText() CLASS HBEditor
LOCAL cString := ""
LOCAL cEOL := HB_OSNewLine()
IF ::lWordWrap
AEval( ::aText, {| cItem | cString += cItem:cText + iif( cItem:lSoftCR, "", cEOL ) },, ::naTextLen - 1 )
ELSE
AEval( ::aText, {| cItem | cString += cItem:cText + cEOL },, ::naTextLen - 1 )
ENDIF
// Last line does not need a cEOL delimiter
cString += ::aText[ ::naTextLen ]:cText
RETURN cString
METHOD GotoLine( nRow ) CLASS HBEditor
IF nRow <= ::naTextLen .AND. nRow > 0
// Back one line
IF ::nRow - nRow == 1
::MoveCursor( K_UP )
ELSEIF ::nRow - nRow == -1
::MoveCursor( K_DOWN )
ELSE
// 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 ::nFirstRow > 1
IF nRow < ::nNumRows .AND. ( ::nTop + nRow ) < ::Row()
::SetPos( ::nTop + nRow, ::Col() )
ENDIF
ELSE
IF nRow <= ::nNumRows
::SetPos( ::nTop + nRow - 1, ::Col() )
ENDIF
ENDIF
::nRow := nRow
IF ! ( ::nFirstRow == 1 .AND. nRow <= ::nNumRows )
::nFirstRow := Max( 1, nRow - ( ::Row() - ::nTop ) )
ENDIF
::display()
ENDIF
ENDIF
RETURN Self
METHOD LineCount() CLASS HBEditor
RETURN ::naTextLen
// 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 HBEditor
LOCAL nFirstSpace
LOCAL cLine
LOCAL cSplittedLine
LOCAL nStartRow
LOCAL nOCol
LOCAL nORow
LOCAL lMoveToNextLine
LOCAL nPosInWord
LOCAL nI
// Do something only if Word Wrapping is on
IF ::lWordWrap .AND. ::LineLen( nRow ) > ::nWordWrapCol
nOCol := ::Col()
nORow := ::Row()
// 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
lMoveToNextLine := RAt( " ", RTrim( ::GetLine( nRow ) ) ) < ::nCol
nPosInWord := Len( ::GetLine( nRow ) ) - ::nCol
nStartRow := nRow
cLine := ::GetParagraph( nRow )
DO WHILE !Empty(cLine)
IF Len( cLine ) > ::nWordWrapCol
nFirstSpace := ::nWordWrapCol
// Split line at fist space before current position
DO WHILE !( SubStr( cLine, --nFirstSpace, 1 ) == " " ) .AND. nFirstSpace > 1
ENDDO
// If there is a space before beginning of line split there
IF nFirstSpace > 1
cSplittedLine := Left( cLine, nFirstSpace )
ELSE
// else split at current cursor position
cSplittedLine := Left( cLine, ::nCol - 1 )
ENDIF
::InsertLine( cSplittedLine, .T., nStartRow++ )
ELSE
// remainder of line
cSplittedLine := cLine
::InsertLine( cSplittedLine, .F., nStartRow++ )
ENDIF
cLine := Right( cLine, Len( cLine ) - Len( cSplittedLine ) )
ENDDO
IF lMoveToNextLine
::MoveCursor( K_DOWN )
::MoveCursor( K_HOME )
::MoveCursor( K_CTRL_RIGHT )
IF nPosInWord > 0
// from 0 since I have to take into account previous K_CTRL_RIGHT which moves me past end of word
FOR nI := 0 TO nPosInWord
::MoveCursor( K_LEFT )
NEXT
ENDIF
ELSE
::SetPos( nORow, nOCol )
ENDIF
::display()
ENDIF
RETURN Self
// Redraws a screenfull of text
METHOD display() CLASS HBEditor
LOCAL i
LOCAL nOCol := ::Col()
LOCAL nORow := ::Row()
DispBegin()
FOR i := 0 TO Min( ::nNumRows - 1, ::naTextLen - 1 )
hb_dispOutAt( ::nTop + i, ::nLeft, PadR( SubStr( ::GetLine( ::nFirstRow + i ), ::nFirstCol, ::nNumCols ), ::nNumCols, " " ), ::LineColor( ::nFirstRow + i ) )
NEXT
// Clear rest of editor window (needed when deleting lines of text)
IF ::naTextLen < ::nNumRows
hb_scroll( ::nTop + ::naTextLen, ::nLeft, ::nBottom, ::nRight,,, ::cColorSpec )
ENDIF
::SetPos( nORow, nOCol )
DispEnd()
RETURN Self
// Redraws current screen line
METHOD RefreshLine() CLASS HBEditor
hb_dispOutAt( ::Row(), ::nLeft, PadR( SubStr( ::GetLine( ::nRow ), ::nFirstCol, ::nNumCols ), ::nNumCols, " " ), ::LineColor( ::nRow ) )
RETURN Self
// Refreshes only one screen column of text (for Left() and Right() movements)
METHOD RefreshColumn() CLASS HBEditor
LOCAL i
DispBegin()
FOR i := 0 TO Min( ::nNumRows - 1, ::naTextLen - 1 )
hb_dispOutAt( ::nTop + i, ::Col(), SubStr( ::GetLine( ::nFirstRow + i ), ::nCol, 1 ), ::LineColor( ::nFirstRow + i ) )
NEXT
DispEnd()
RETURN Self
// Returns color string to use to draw nRow (current line if nRow is empty)
METHOD LineColor( nRow ) CLASS HBEditor
HB_SYMBOL_UNUSED( nRow )
RETURN ::cColorSpec
// Handles cursor movements inside text array
METHOD MoveCursor( nKey ) CLASS HBEditor
LOCAL lMoveKey := .T.
DO CASE
CASE nKey == K_DOWN
IF !::lEditAllow
DO WHILE ::Row() < ::nBottom .AND. ::nRow < ::naTextLen
::nRow++
::SetPos( ::Row() + 1, ::Col() )
ENDDO
ENDIF
IF ::Row() == ::nBottom
IF ::nRow < ::naTextLen
hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, 1 )
::nFirstRow++
::nRow++
::RefreshLine()
ENDIF
ELSE
IF ::nRow < ::naTextLen
::nRow++
::SetPos( ::Row() + 1, ::Col() )
ENDIF
ENDIF
CASE nKey == K_PGDN
IF ::nRow + ::nNumRows < ::naTextLen
::nRow += ::nNumRows
::nFirstRow += ::nNumRows
IF ::nFirstRow + ::nNumRows > ::naTextLen
::nFirstRow -= ( ( ::nFirstRow + ::nNumRows ) - ::naTextLen ) + 1
ENDIF
ELSE
::nFirstRow := Max( ::naTextLen - ::nNumRows + 1, 1 )
::nRow := ::naTextLen
::SetPos( Min( ::nTop + ::naTextLen - 1, ::nBottom ), ::Col() )
ENDIF
::display()
CASE nKey == K_CTRL_PGDN
::nRow := ::naTextLen
::nCol := Max( ::LineLen( ::nRow ), 1 )
::nFirstRow := Max( ::naTextLen - ::nNumRows + 1, 1 )
::nFirstCol := Max( ::nCol - ::nNumCols + 1, 1 )
::SetPos( Min( ::nTop + ::naTextLen - 1, ::nBottom ), Min( ::nLeft + ::nCol - 1, ::nRight ) )
::display()
CASE nKey == K_UP
IF ! ::lEditAllow
DO WHILE ::Row() > ::nTop .AND. ::nRow > 1
::nRow--
::SetPos( ::Row() - 1, ::Col() )
ENDDO
ENDIF
IF ::Row() == ::nTop
IF ::nRow > 1
hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight, -1 )
::nFirstRow--
::nRow--
::RefreshLine()
ENDIF
ELSE
::nRow--
::SetPos( ::Row() - 1, ::Col() )
ENDIF
CASE nKey == K_PGUP
IF ( ::nRow - ::nNumRows ) > 1
::nRow -= ::nNumRows
::nFirstRow -= ::nNumRows
IF ::nFirstRow < 1
::nFirstRow := 1
ENDIF
ELSE
::nFirstRow := 1
::nRow := 1
::SetPos( ::nTop, ::Col() )
ENDIF
::display()
CASE nKey == K_CTRL_PGUP
::nRow := 1
::nCol := 1
::nFirstCol := 1
::nFirstRow := 1
::SetPos( ::nTop, ::nLeft )
::display()
CASE nKey == K_RIGHT
IF ::Col() == ::nRight
IF ::nCol <= iif( ::lWordWrap, ::nWordWrapCol, ::LineLen( ::nRow ) )
hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, 1 )
::nFirstCol++
::nCol++
::RefreshColumn()
ENDIF
ELSE
::nCol++
::SetPos( ::Row(), ::Col() + 1 )
ENDIF
CASE nKey == K_CTRL_RIGHT
// NOTE: should be faster without call to ::GetLine()
DO WHILE ::nCol <= iif( ::lWordWrap, Min( ::nWordWrapCol, ::LineLen( ::nRow ) ), ::LineLen( ::nRow ) ) .AND. !( SubStr( ::aText[ ::nRow ]:cText, ::nCol, 1 ) == " " )
::MoveCursor( K_RIGHT )
ENDDO
DO WHILE ::nCol <= iif( ::lWordWrap, Min( ::nWordWrapCol, ::LineLen( ::nRow ) ), ::LineLen( ::nRow ) ) .AND. SubStr( ::aText[ ::nRow ]:cText, ::nCol, 1 ) == " "
::MoveCursor( K_RIGHT )
ENDDO
CASE nKey == K_LEFT
IF ::Col() == ::nLeft
IF ::nCol > 1
hb_scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,, -1 )
::nFirstCol--
::nCol--
::RefreshColumn()
ENDIF
ELSE
::nCol--
::SetPos( ::Row(), ::Col() - 1 )
ENDIF
CASE nKey == K_CTRL_LEFT
DO WHILE ::nCol > 1 .AND. !( SubStr( ::aText[ ::nRow ]:cText, ::nCol, 1 ) == " " )
::MoveCursor( K_LEFT )
ENDDO
DO WHILE ::nCol > 1 .AND. SubStr( ::aText[ ::nRow ]:cText, ::nCol, 1 ) == " "
::MoveCursor( K_LEFT )
ENDDO
CASE nKey == K_HOME
::nCol := 1
::nFirstCol := 1
::SetPos( ::Row(), ::nLeft )
::display()
CASE nKey == K_CTRL_HOME
::nCol := 1
::nFirstCol := 1
::nRow -= ( ::Row() - ::nTop )
::SetPos( ::nTop, ::nLeft )
::display()
CASE nKey == K_END
// Empty lines have 0 len
::nCol := Max( ::LineLen( ::nRow ) + 1, 1 )
::nFirstCol := Max( ::nCol - ::nNumCols + 1, 1 )
::SetPos( ::Row(), Min( ::nLeft + ::nCol - 1, ::nRight ) )
::display()
CASE nKey == K_CTRL_END
::nRow += ::nBottom - ::Row()
IF ::nRow > ::naTextLen
::nRow := ::naTextLen
ENDIF
::nCol := Max( ::LineLen( ::nRow ), 1 )
::nFirstCol := Max( ::nCol - ::nNumCols + 1, 1 )
::SetPos( Min( ::nTop + ::naTextLen - 1, ::nBottom ), Min( ::nLeft + ::nCol - 1, ::nRight ) )
::display()
OTHERWISE
lMoveKey := .F.
ENDCASE
RETURN lMoveKey
// Changes lInsert value and insertion / overstrike mode of editor
METHOD InsertState( lInsState ) CLASS HBEditor
IF ISLOGICAL( lInsState )
::lInsert := lInsState
Set( _SET_INSERT, lInsState )
IF ::lEditAllow
SetCursor( iif( lInsState, SC_INSERT, SC_NORMAL ) )
ENDIF
ENDIF
RETURN Self
// Edits text
METHOD Edit( nPassedKey ) CLASS HBEditor
LOCAL i
LOCAL nKey
LOCAL lDelAppend
LOCAL bKeyBlock
LOCAL lSingleKeyProcess := .F. // .T. if I have to process passed key and then exit
IF ! ::lEditAllow
::BrowseText( nPassedKey )
ELSE
// 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 )
ELSE
lSingleKeyProcess := .T.
nKey := nPassedKey
ENDIF
// 03/sept/2002 - maurilio.longo@libero.it
// NOTE: I think this code should only be present on classes derived from TEditor which is
// a low level "editing engine".. For now I leave it here...
IF ( bKeyBlock := SetKey( nKey ) ) != NIL
Eval( bKeyBlock )
LOOP
ENDIF
DO CASE
CASE nKey >= K_SPACE .AND. nKey < 256
::lDirty := .T.
// If I'm past EOL I need to add as much spaces as I need to reach ::nCol
IF ::nCol > ::LineLen( ::nRow )
::aText[ ::nRow ]:cText += Space( ::nCol - ::LineLen( ::nRow ) )
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 ) )
ELSE
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, Chr( nKey ) )
ENDIF
::MoveCursor( K_RIGHT )
::RefreshLine()
::SplitLine( ::nRow )
CASE nKey == K_RETURN
::lDirty := .T.
IF ::lInsert .OR. ::nRow == ::naTextLen
IF ::LineLen( ::nRow ) > 0
// Split current line at cursor position
::InsertLine( Right( ::aText[ ::nRow ]:cText, ::LineLen( ::nRow ) - ::nCol + 1 ), ::aText[ ::nRow ]:lSoftCR, ::nRow + 1 )
::aText[ ::nRow ]:cText := Left( ::aText[ ::nRow ]:cText, ::nCol - 1 )
IF ::lWordWrap
::aText[ ::nRow ]:lSoftCR := .F.
ENDIF
ELSE
::InsertLine( "", .F., ::nRow + 1 )
ENDIF
ENDIF
::MoveCursor( K_DOWN )
::MoveCursor( K_HOME )
CASE nKey == K_INS
::InsertState( !::lInsert )
CASE nKey == K_DEL
// If there is a wordwrapping limit and I'm past it
IF ::lWordWrap .AND. ::nCol > ::nWordWrapCol
::MoveCursor( K_DOWN )
::MoveCursor( K_HOME )
ELSE
::lDirty := .T.
// If I'm on last char of a line and there are more lines, append next line to current one
lDelAppend := ::nCol > ::LineLen( ::nRow )
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, "" )
IF lDelAppend
IF ::nRow < ::naTextLen
::aText[ ::nRow ]:cText += ::GetLine( ::nRow + 1 )
::RemoveLine( ::nRow + 1 )
::SplitLine( ::nRow )
::display()
ELSE
::RefreshLine()
ENDIF
ELSE
::RefreshLine()
ENDIF
ENDIF
CASE nKey == K_TAB
// 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, Space( ::nTabWidth ) )
::lDirty := .T.
ENDIF
FOR i := 1 TO ::nTabWidth
::MoveCursor( K_RIGHT )
NEXT
::RefreshLine()
CASE nKey == K_BS
::lDirty := .T.
// delete previous character
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, --::nCol, 1, "" )
// correct column position for next call to MoveCursor()
::nCol++
::MoveCursor( K_LEFT )
::RefreshLine()
CASE nKey == K_CTRL_Y
::lDirty := .T.
IF ::naTextLen > 1
::RemoveLine( ::nRow )
// if we have less lines of text than our current position, up one line
IF ::nRow > ::naTextLen
::nRow := Max( ::nRow - 1, 1 )
// if our position on screen exceeds text length, up one row
IF ( ::nFirstRow + ::nNumRows - 1 ) > ::naTextLen
::SetPos( Max( ::Row() - 1, ::nTop ), ::Col() )
ENDIF
// if first line of displayed text is less than length of text
IF ::nFirstRow > ::naTextLen
::nFirstRow := Max( ::nFirstRow - 1, 1 )
ENDIF
ENDIF
::display()
ELSE
::aText[ ::nRow ]:cText := ""
::RefreshLine()
ENDIF
CASE ::MoveCursor( nKey )
// if it's a movement key ::MoveCursor() handles it
CASE nKey == K_ALT_W
/* TOFIX: Not clipper compatible */
::lSaved := .T.
::lExitEdit := .T.
OTHERWISE
/* 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 */
::KeyboardHook( nKey )
ENDCASE
ENDDO
ENDIF
RETURN Self
METHOD ExitState() CLASS HBEditor
RETURN ::lExitEdit
// This in an empty method which can be used by classes subclassing HBEditor to be able
// to handle particular keys.
METHOD KeyboardHook( nKey ) CLASS HBEditor
IF nKey == K_ESC
::lSaved := .F.
::lExitEdit := .T.
ENDIF
RETURN Self
// There are no more keys to handle. Can I do something for you?
METHOD IdleHook() CLASS HBEditor
RETURN Self
METHOD SetColor( cColorString ) CLASS HBEditor
LOCAL cOldColor := ::cColorSpec
IF ISCHARACTER( cColorString )
::cColorSpec := cColorString
ENDIF
RETURN cOldColor
METHOD Hilite() CLASS HBEditor
// Swap CLR_STANDARD and CLR_ENHANCED
LOCAL cEnhanced := hb_TokenGet( ::cColorSpec, 2, "," ) + "," +;
hb_TokenGet( ::cColorSpec, 1, "," )
::SetColor( cEnhanced + Right( ::cColorSpec, Len( ::cColorSpec ) - Len( cEnhanced ) ) )
RETURN Self
METHOD DeHilite() CLASS HBEditor
// Swap CLR_STANDARD and CLR_ENHANCED back to their original position inside cColorSpec
LOCAL cStandard := hb_TokenGet( ::cColorSpec, 2, "," ) + "," +;
hb_TokenGet( ::cColorSpec, 1, "," )
::SetColor( cStandard + Right( ::cColorSpec, Len( ::cColorSpec ) - Len( cStandard ) ) )
RETURN Self
METHOD SetPos( nRow, nCol ) CLASS HBEditor
DEFAULT nRow TO ::nPhysRow
DEFAULT nCol TO ::nPhysCol
::nPhysRow := nRow
::nPhysCol := nCol
SetPos( ::nPhysRow, ::nPhysCol )
RETURN ::nPhysRow
// Same as clipper ones, returns ::nPhysRow value
METHOD Row() CLASS HBEditor
RETURN ::nPhysRow
// Same as clipper ones, returns ::nPhysCol value
METHOD Col() CLASS HBEditor
RETURN ::nPhysCol
METHOD RowPos() CLASS HBEditor
RETURN ::nRow
METHOD ColPos() CLASS HBEditor
RETURN ::nCol
METHOD Saved() CLASS HBEditor
RETURN ::lSaved
METHOD Changed() CLASS HBEditor
RETURN ::lDirty
METHOD IsWordWrap() CLASS HBEditor
RETURN ::lWordWrap
METHOD WordWrapCol() CLASS HBEditor
RETURN ::nWordWrapCol
METHOD hitTest( nMRow, nMCol ) CLASS HBEditor
IF nMRow >= ::nTop .AND. ;
nMRow <= ::nBottom .AND. ;
nMCol >= ::nLeft .AND. ;
nMCol <= ::nRight
RETURN HTCLIENT
ENDIF
RETURN HTNOWHERE
/* -------------------------------------------- */
// Rebuild a long line from multiple short ones (wrapped at soft CR)
METHOD GetParagraph( nRow )
LOCAL cLine := ""
DO WHILE nRow <= Len( ::aText ) .AND. ::aText[ nRow ]:lSoftCR
cLine += ::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
::RemoveLine( nRow )
ENDDO
IF nRow <= Len( ::aText )
// Last line, or only one line
cLine += ::aText[ nRow ]:cText
::RemoveLine( nRow )
ENDIF
RETURN cLine
// if editing isn't allowed we enter this loop which
// handles only movement keys and discards all the others
METHOD BrowseText( nPassedKey )
LOCAL nKey
LOCAL bKeyBlock
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 )
LOOP
ENDIF
IF nKey == K_ESC
::lExitEdit := .T.
ELSE
IF !::MoveCursor( nKey )
::KeyboardHook( nKey )
ENDIF
ENDIF
IF nPassedKey != NIL
EXIT
ENDIF
ENDDO
RETURN Self
/* -------------------------------------------- */
METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabSize, nTextRow, nTextCol, nWndRow, nWndCol ) CLASS HBEditor
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
DEFAULT nWndRow TO 0
DEFAULT nWndCol TO 0
::aText := Text2Array( cString, nLineLength )
::naTextLen := Len( ::aText )
IF ::naTextLen == 0
AAdd( ::aText, HBTextLine():New() )
::naTextLen++
ENDIF
// editor window boundaries
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::cColorSpec := SetColor()
// How many cols and rows are available
::nNumCols := nRight - nLeft + 1
::nNumRows := nBottom - nTop + 1
IF ISLOGICAL( lEditMode )
::lEditAllow := lEditMode
ENDIF
// set correct insert state
IF ::lEditAllow
::InsertState( ::lInsert )
ENDIF
// is word wrap required?
IF ISNUMBER( nLineLength )
::lWordWrap := .T.
::nWordWrapCol := nLineLength
ENDIF
// how many spaces for each tab?
IF ISNUMBER( nTabSize )
::nTabWidth := nTabSize
ENDIF
// textrow/col, wndrow/col management
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 )
::nRow := Max( 1, Min( nTextRow, ::naTextLen ) )
::nCol := Max( 1, Min( Len( ::aText[ ::nRow ]:cText ), nTextCol + 1 ) )
// extra sanitization over max bounds
IF ::nFirstRow > ::naTextLen
::nFirstRow := ::naTextLen
ENDIF
IF ::nFirstCol > ::LineLen( ::nRow ) + 1
::nFirstCol := ::LineLen( ::nRow ) + 1
ENDIF
IF ( ::nFirstRow + nWndRow ) > ::naTextLen
DO WHILE ( ::nFirstRow + ( --nWndRow ) ) > ::naTextLen
ENDDO
ENDIF
// Empty area of screen which will hold editor window
hb_scroll( nTop, nLeft, nBottom, nRight )
// Set cursor upper left corner
//::SetPos( ::nTop, ::nLeft )
::SetPos( ::nTop + nWndRow, ::nLeft + nWndCol )
RETURN Self
/* -------------------------------------------- */
// 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_OSNewLine()
// Converts a string to an array of strings splitting input string at EOL boundaries
STATIC FUNCTION Text2Array( cString, nWordWrapCol )
LOCAL aArray := {}
LOCAL cEOL := WhichEOL( cString )
LOCAL nEOLLen := Len( cEOL )
LOCAL nRetLen := 0
LOCAL ncSLen := Len( cString )
LOCAL nTokPos := 0
LOCAL cLine
LOCAL nFirstSpace
LOCAL cSplittedLine
DO WHILE nRetLen < ncSLen
cLine := hb_TokenPtr( @cString, @nTokPos, cEOL )
nRetLen += Len( cLine ) + nEOLLen
IF nWordWrapCol != NIL .AND. Len( cLine ) > nWordWrapCol
DO WHILE !Empty( cLine )
// Split line at nWordWrapCol boundary
IF Len( cLine ) > nWordWrapCol
nFirstSpace := nWordWrapCol
DO WHILE !( SubStr( cLine, --nFirstSpace, 1 ) == " " ) .AND. nFirstSpace > 1
ENDDO
IF nFirstSpace > 1
cSplittedLine := Left( cLine, nFirstSpace )
ELSE
cSplittedLine := Left( cLine, nWordWrapCol )
ENDIF
AAdd( aArray, HBTextLine():New( cSplittedLine, .T. ) )
ELSE
// remainder of line is shorter than split point
cSplittedLine := cLine
AAdd( aArray, HBTextLine():New( cSplittedLine, .F. ) )
ENDIF
cLine := Right( cLine, Len( cLine ) - Len( cSplittedLine ) )
ENDDO
ELSE
AAdd( aArray, HBTextLine():New( cLine, .F. ) )
ENDIF
ENDDO
RETURN aArray
Reference in New Issue View Git Blame Copy Permalink