*========================================================================================
*
* Version: 2010-02Feb-20
*
*========================================================================================
*
* This program implements partial IntelliSense in VFP 6-9. To enable
* IntelliSenseX, simply execute this program at any time when using
* Visual FoxPro or put it into your startup program.
*
* To configure ISX please see the section just below the comment block.
*
* To stop IntelliSenseX run this program again and pass "QUIT" as a
* parameter. Alternatively, you can simply remove the ON KEY LABEL
* macros for the ALT+I and the "." key.
*
* Currently only IntelliSense for variable names is implemented. This
* means that whenever you enter "m." in a MODIFY COMMAND window or
* in a Method edit window, you get a list of all variables declared
* in the current procedure. ISX doesn't parse the entire sourcecode
* for memory variables, but only the current procedure or method and
* only those variables listed in a LOCAL, PRIVATE, PUBLIC, LPARAMETER
* and PARAMETER statement. ALT+I can be used to trigger this list.
*
* ALT+RIGHTARROW triggers a universal autocomplete function that tries to determine the
* type of what you have entered and offers a list of all possible values.
*
* Please note that I haven't written this program as an excercise for
* good coding styles <g>, rather as an excercise to see if
* IntelliSense is possible within Visual FoxPro itself. Therefore
* you won't find the Assertions you would otherwise find in my code.
*
*========================================================================================
*
* Acknowledgements
*
* Thanks to George Tasker for his really helpful documentation on the
* FoxTools.Fll. You can download his ToolHelp.Hlp file from the
* UniversalThread and the CompuServe MSDEVAPP forum. George also made
* some suggestions to improve this program.
*
* Also thanks to Ken Levy, who couldn't implement an inline Intelli-
* Sense feature in his SuperCls and thereby convinced me that there
* must be a way to do it, even only for the purpose of doing
* something that Ken Levy couldn't do. <bg>
*
* Thanks to all the folks that posted me bug reports, especially
* Frank Cazabon. Thanks to Gerry Hughes for correcting the typos in
* my comments.
*
* Louis D. Zelus added a nifty feature to my version to make ISX
* even more useful. Thanks for that! The code based on his work is
* marked with "LDZ:".
*
* Sietse Wijnkler added a lot of new cool features: He added the
* ability to distinguish different types that all are triggered by
* a period and the code to display variables, object properties and
* field names. Code based on his work is marked with "SW:".
*
* J黵gen "wOOdy" Wondzinski pointed out that special characters like
* "�" are valid variable names and IsAlpha() returns .T. for them.
* Therefore any of these characters is detected by ISX, as well.
*
* Tamar E. Granor and Peter Steinke, both requested the list DEFINE
* features which is why I finally added it.
*
* Thanks to Eddy Maue for his contributions:
*
* Ce qu'ile fait de plus maintenant
* - Alt-Q pour arr阾er Isx
* - Alt-Q pour redemarrer Isx
* - Ouvre automatiquements :
* -Les tables pr閟entes dans les r閜ertoires courants et de recherches
* (set path to)
* -Les vues pr閟entes dans le projet actif
* -Les query pr閟ents dans les r閜ertoires courants et de recherches
* (set path to)
* Petit point � ne pas n間liger. Le curseur produit par le fichier
* MyQuery.qpr doit 阾re du m阭e nom que le fichier
*
* In English:
*
* - ALT+Q enables/disables ISX
* - files are opened automatically:
* - tables available in the current directory or the search path (SET PATH TO)
* - Views available in the current project
* - Queries available in the current directory or the search path (SET PATH TO)
* Minor, but important restriction: The cursor created by the query program
* must have the same alias as the filename.
* Mike Yearwood added supported for maximized editing windows which caused a lot
* of flickering everytime the popup came up.
*
* Thanks to all those who pointed out bugs in ISX's releases:
*
* - Nina Schwanzer
* - Del Lee
* - Pamela Thalacker
* - Christophe Chenavier
* - Aragorn Rockstroh
* - Claude Hebert
* - Jens Kippnich
* - Stefan W黚be
*
*========================================================================================
*
* This program has been written in 1999-2005 by Christof Wollenhaupt
* and is placed into Public Domain. You can use the entire
* code or parts of it as you like in any private or commercial
* application. None of the contributors to this programm can be hold
* liable for any damage or problems, using this program may cause.
*
* If you added a new feature, please let me know. If you want I add
* your feature to my master copy of ISX to let others use your
* feature, as well. Please note that since the entire program is
* placed into Public Domain, this places your code into Public
* Domain, as well. Of course, your contributions are acknlowdeged in
* the comment at the beginning of this file.
*
*========================================================================================
*
* Known problems:
*
* - So far ISX has not been tested with different Display appearance
* settings, like wider scrollbars or form borders, large fonts and
* the like. Some values are hardcoded and might be wrong for non-
* standard Windows settings.
*
* - When you enter a period into a textbox, the cursor is set to the first character of
* the textbox and then the period entered. If SelectOnEntry is true, everything is
* replaced by the period. This is caused by a bug in VFP that makes all ON KEY LABEL
* behave this way. You can disable this behavior by commenting out the lines starting
* with "ON KEY LABEL .". In this case, you must use ALT+I or ALT+RIGHTARROW do expand
* the variable.
*
*========================================================================================
*========================================================================================
* Configuration.
*
* Over the time I got many enhanced versions of ISX, many of which include new hotkeys.
* To give everyone control over the hotkey assignment and to disable/enable particular
* features, I added the following configuration section. By commenting out a #DEFINE, you
* disable a particular feature. Changing the value changes the hotkey.
*
*========================================================================================
#DEFINE EXPAND_VARIABLE ALT+I
#DEFINE DOT_ACTIVATION .
#DEFINE LIST_ALL ALT+RIGHTARROW
#DEFINE TOGGLE_ISX ALT+Q
*========================================================================================
* Main program
*========================================================================================
Lparameters tcAction, tcParam, tcParam2
Do Case
Case Vartype(m.tcAction) == "L"
InstallISX()
Case Upper(Alltrim(m.tcAction)) == "AUTOCOMPLETE"
Push Key Clear
AutoComplete( m.tcParam, m.tcParam2 )
Pop Key
Case Upper(Alltrim(m.tcAction)) == "QUIT"
UninstallISX()
Endcase
Return
*========================================================================================
* Activates the hotkeys.
*========================================================================================
Procedure InstallISX
Local lcISXProgram
lcISXProgram = ["] + Sys(16,Program(-1)-1) + ["]
#IFDEF EXPAND_VARIABLE
On Key Label EXPAND_VARIABLE Do &lcISXProgram With "AUTOCOMPLETE", "VAR", ""
#ENDIF
#IFDEF DOT_ACTIVATION
On Key Label DOT_ACTIVATION Do &lcISXProgram With "AUTOCOMPLETE", "VAR,OBJ,TABLE", "."
#ENDIF
#IFDEF LIST_ALL
On Key Label LIST_ALL Do &lcISXProgram With "AUTOCOMPLETE", "", ""
#ENDIF
#IFDEF TOGGLE_ISX
On Key Label TOGGLE_ISX Do &lcISXProgram With "QUIT"
Wait Window Nowait [ISX up and running... TOGGLE_ISX to quit]
#ELSE
Wait Window nowait "ISX up and running..."
#ENDIF
EndProc
*====================================================================
* Deactivates the hotkeys.
*====================================================================
Procedure UninstallISX
Local lcISXProgram
lcISXProgram = ["] + Sys(16,Program(-1)-1) + ["]
#IFDEF EXPAND_VARIABLE
On Key Label EXPAND_VARIABLE
#ENDIF
#IFDEF DOT_ACTIVATION
On Key Label DOT_ACTIVATION
#ENDIF
#IFDEF LIST_ALL
On Key Label LIST_ALL
#ENDIF
#IFDEF TOGGLE_ISX
On Key Label TOGGLE_ISX Do &lcISXProgram
Wait Window Nowait [ISX terminated... TOGGLE_ISX to restart]
#ELSE
Wait Window nowait "ISX terminated..."
#ENDIF
EndProc
*========================================================================================
* Provides a generic autocomplete function. AutoComplete checks all content providers
* if they have something to add to the global list and displays the list as a popup
*========================================================================================
Procedure AutoComplete
Lparameters tcProviders, tcInvocation
*--------------------------------------------------------------------------------------
* The list of providers can be limited. This speeds up program execution if one knows
* from the context that only few content providers actually fit.
*--------------------------------------------------------------------------------------
Local lcProviders
If Empty(m.tcProviders)
lcProviders = "VAR,DEFINE,TABLE,OBJ"
Else
lcProviders = Upper(m.tcProviders)
EndIf
*-----------------------------------------------------------------
* Make sure, FoxTools.Fll is loaded.
*-----------------------------------------------------------------
If not "FOXTOOLS.FLL" $ Upper(Set("Library"))
Set Library to (Home()+"FoxTools.Fll") Additive
Endif
*-----------------------------------------------------------------
* Get the current window and verify that it is a valid window.
*-----------------------------------------------------------------
Local lnWHandle
lnWHandle = GetCurrentWindow()
If lnWHandle == 0
If not Empty(m.tcInvocation)
Clear TypeAhead
Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain
Endif
Return
Endif
*-----------------------------------------------------------------
* Verify that the current window is indeed an edit window.
*-----------------------------------------------------------------
Local lnEditSource
lnEditSource = GetEditSource(m.lnWHandle)
If not InList( m.lnEditSource, 1, 8, 10, 12 )
If not Empty(m.tcInvocation)
Clear TypeAhead
Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain
Endif
Return
EndIf
*--------------------------------------------------------------------------------------
* Fill an object with details about the current context. We determine what the user
* has entered so far and what's left from that Position.
*--------------------------------------------------------------------------------------
Local loISX
loISX = CreateObject("Relation")
loISX.AddProperty("nWHandle",m.lnWHandle)
loISX.AddProperty("nEditSource",m.lnEditSource)
loISX.AddProperty("aList[1]")
loISX.AddProperty("nCount",0)
loISX.AddProperty("cTextLeft",GetLineLeftFromCursor(m.lnWHandle))
loISX.AddProperty("cName","")
loISX.AddProperty("cEntity","")
loISX.AddProperty("cInvocation",m.tcInvocation)
*--------------------------------------------------------------------------------------
* Determine the part of the name that has been entered so far. This code has been
* kindly provided by Louis D. Zelus.
*--------------------------------------------------------------------------------------
Local lcLine, lcChar
If Empty(m.tcInvocation)
Do While Len(m.loISX.cTextLeft) > 0
lcChar = Right( m.loISX.cTextLeft, 1 )
If IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar == "_"
loISX.cTextLeft = Left( m.loISX.cTextLeft, Len(m.loISX.cTextLeft)-1 )
loISX.cName = m.lcChar + m.loISX.cName
Else
Exit
Endif
Enddo
EndIf
*--------------------------------------------------------------------------------------
* Determines the name of the entity. This code is courtesy of Sietse Wijnkler.
*--------------------------------------------------------------------------------------
Do While Len(m.loISX.cTextLeft) > 0
lcChar = Right( m.loISX.cTextLeft, 1 )
If IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar == "_" or m.lcChar == "."
loISX.cTextLeft = Left( m.loISX.cTextLeft, Len(m.loISX.cTextLeft)-1 )
loISX.cEntity = m.lcChar + m.loISX.cEntity
Else
Exit
Endif
EndDo
If Right(loISX.cEntity,1) == "."
loISX.cEntity = Left( m.loISX.cEntity, Len(m.loISX.cEntity)-1 )
EndIf
*--------------------------------------------------------------------------------------
* This array lists all the providers
*--------------------------------------------------------------------------------------
Local laProvider[4,2]
laProvider = ""
laProvider[1,1] = "VAR"
laProvider[1,2] = "CP_Variables"
laProvider[2,1] = "DEFINE"
laProvider[2,2] = "CP_Defines"
laProvider[3,1] = "TABLE"
laProvider[3,2] = "CP_Tables"
laProvider[4,1] = "OBJ"
laProvider[4,2] = "CP_Objects"
*--------------------------------------------------------------------------------------
* Get data from each provider and merge it into the list
*--------------------------------------------------------------------------------------
Local laAll[1], lnAll, laRequest[1], lnRequest, lnProvider
lnAll = 0
For lnRequest=1 to ALines(laRequest,Chrtran(m.lcProviders,",",Chr(13)+Chr(10)),.T.)
For lnProvider=1 to Alen(laProvider,1)
If Upper(Alltrim(laRequest[m.lnRequest])) == laProvider[m.lnProvider,1]
loISX.nCount = 0
Dimension loISX.aList[1]
loISX.aList = ""
&laProvider[m.lnProvider,2](m.loISX)
If m.loISX.nCount > 0
Dimension laAll[m.lnAll+m.loISX.nCount]
Acopy(m.loISX.aList,laAll,1,m.loISX.nCount, m.lnAll+1)
lnAll = m.lnAll + m.loISX.nCount
EndIf
EndIf
EndFor
EndFor
*--------------------------------------------------------------------------------------
* If there's anything in the list, display the popup
*--------------------------------------------------------------------------------------
If m.lnAll == 0
If not Empty(m.tcInvocation)
Clear TypeAhead
Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain
Endif
Else
If not Empty(m.tcInvocation)
InsertText( m.lnWHandle, m.tcInvocation )
EndIf
loISX.nCount = m.lnAll
Dimension loISX.aList[loISX.nCount]
Acopy(laAll,loISX.aList)
DisplayPopup(loISX)
EndIf
EndProc
*========================================================================================
* Determines all include files that fit in the current situation and adds them to the
* list.
*========================================================================================
Procedure CP_Defines
Lparameters toISX
Local loFile
If Type("_VFP.ActiveProject") == "O"
For each loFile in _VFP.ActiveProject.Files
If Upper(JustExt(loFile.Name)) == "H"
ReadDefines(m.toISX,loFile.Name)
EndIf
EndFor
Else
ReadDefines(m.toISX,Home()+"FoxPro.H")
EndIf
EndProc
*========================================================================================
* Adds all constants from an include file to the array.
*========================================================================================
Procedure ReadDefines
LParameter toISX, tcFile
*--------------------------------------------------------------------------------------
* File must exist.
*--------------------------------------------------------------------------------------
If not File(m.tcFile)
Return
EndIf
*--------------------------------------------------------------------------------------
* To increase performance, we cache files if possible.
*--------------------------------------------------------------------------------------
Local laDefine[1], lnItem, lnCount
If not IsInCache( "DEFINE", m.toISX, m.tcFile )
If Version(4) >= "07.00"
lnCount = AProcInfo(laDefine,m.tcFile)
Else
lnCount = X6_AProcInfo(@laDefine,m.tcFile)
EndIf
For lnItem=1 to m.lnCount
If laDefine[m.lnItem,3] == "Define"
toISX.nCount = toISX.nCount + 1
Dimension toISX.aList[toISX.nCount]
toISX.aList[toISX.nCount] = laDefine[m.lnItem,1]
EndIf
EndFor
AddToCache( "DEFINE", m.toISX, m.tcFile )
EndIf
EndProc
*========================================================================================
* The cache is an array in _SCREEN that holds the name of the file, the time stamp, the
* provider ID and the contents of the array.
*========================================================================================
Procedure IsInCache
LParameter tcProvider, toISX, tcFile
If Type("_Screen.ISXCache[1,1]") == "U"
Return .F.
EndIf
Local lnLine
If Version(4) >= "07.00"
lnLine = Ascan( _Screen.ISXCache, m.tcFile+"?"+m.tcProvider, -1, -1, 1, 1+2+4+8 )
Else
Local lnCurLine
lnLine = 0
For lnCurLine=1 to Alen(_Screen.ISXCache,1)
If Type(_Screen.ISXCache[m.lnCurLine]) == "C"
If Upper(m.tcFile+"?"+m.tcProvider) == Upper(_Screen.ISXCache[m.lnCurLine])
lnLine = lnCurLine
Exit
EndIf
EndIf
EndFor
EndIf
If m.lnLine == 0
Return .F.
EndIf
If Fdate(m.tcFile,1) # _Screen.ISXCache[m.lnLine,2]
Return .F.
EndIf
toISX.nCount = _Screen.ISXCache[m.lnLine,3]
ALines( toISX.aList, _Screen.ISXCache[m.lnLine,4] )
Return .T.
*========================================================================================
* Adds the current entry to the cache.
*========================================================================================
Procedure AddToCache
LParameter tcProvider, toISX, tcFile
If Type("_Screen.ISXCache[1,1]") == "U"
_Screen.AddProperty("ISXCache[1,4]")
EndIf
Local lnLine
If Version(4) >= "07.00"
lnLine = Ascan( _Screen.ISXCache, m.tcFile+"?"+m.tcProvider, -1, -1, 1, 1+2+4+8 )
Else
Local lnCurLine
lnLine = 0
For lnCurLine=1 to Alen(_Screen.ISXCache)
If Upper(m.tcFile+"?"+m.tcProvider) == Upper(_Screen.ISXCache[m.lnCurLine])
lnLine = lnCurLine
Exit
EndIf
EndFor
EndIf
If m.lnLine == 0
lnLine = Alen(_Screen.ISXCache,1) + 1
Dimension _Screen.ISXCache[m.lnLine,Alen(_Screen.ISXCache,2)]
EndIf
Local lnItem
_Screen.ISXCache[m.lnLine,1] = m.tcFile+"?"+m.tcProvider
_Screen.ISXCache[m.lnLine,2] = Fdate(m.tcFile,1)
_Screen.ISXCache[m.lnLine,3] = toISX.nCount
_Screen.ISXCache[m.lnLine,4] = ""
For lnItem=1 to toISX.nCount
_Screen.ISXCache[m.lnLine,4] = _Screen.ISXCache[m.lnLine,4] + ;
toISX.aList[m.lnItem] + Chr(13)+Chr(10)
EndFor
EndProc
*====================================================================
* SW: Fills an array with all PEMs for the objectname typed in
* Returns the number of PEMs. The object has to exist to work
*====================================================================
Procedure CP_Objects
Lparameters toISX
LOCAL lnVarCount
If TYPE(toISX.cEntity) = [O]
If Version(4) >= "07.00"
If Upper(toISX.cEntity) == "_SCREEN" or Upper(toISX.cEntity) == "_VFP" ;
OR Upper(toISX.cEntity) = "_VFP."
Return
EndIf
EndIf
Local laMembers[1]
toISX.nCount = AMEMBERS(laMembers, Evaluate(toISX.cEntity), 1)
Dimension toISX.aList[m.toISX.nCount]
FOR m.lnCount = 1 TO toISX.nCount
toISX.aList[m.lnCount] = PROPER(laMembers[m.lnCount,1])
NEXT
EndIf
EndProc
*====================================================================
* SW: Fills an array with all Fields for the cursor typed in.
* Returns the number of Fields. The cursor has to be open to work
*====================================================================
Procedure CP_Tables
Lparameters toISX
LOCAL lnCount, lcName
lcName = JustStem(toISX.cEntity)
* November 11, 2004 Modified by Eddy Maue
If Occurs(".",toISX.cEntity)==0 And !"m." == LOWER(toISX.cEntity+".") AND ;
IIF(Used(m.lcName),.t.,;
IIF(File(m.lcName+".dbf"),OpenTable(m.lcName),;
IIF(File(m.lcName+".qpr"),ExecQuery(m.lcName),OpenView(m.lcName))))
toISX.nCount = FCOUNT(m.lcName)
DIMENSION toISX.aList[toISX.nCount]
FOR m.lnCount = 1 TO toISX.nCount
toISX.aList[m.lnCount] = PROPER(FIELD(m.lnCount, m.lcName))
NEXT
ENDIF
EndProc
*====================================================================
* Open the table
* Eddy Maue
* November 11, 2004
*====================================================================
Procedure OpenTable
Lparameters lcName
Use (m.lcName) In 0
Return Used(m.lcName)
ENDPROC
*====================================================================
* Open a query
*====================================================================
* Eddy Maue
* November 11, 2004
*====================================================================
Procedure ExecQuery
Lparameters lcName
Do (lcName+".qpr")
Return Used(lcName)
ENDPROC
*====================================================================
* Open a view
*====================================================================
* Eddy Maue
* November 11, 2004
*====================================================================
Procedure OpenView
Lparameters lcName,lcSafety,lcConsol
If Type("_vfp.ActiveProject")="U" .OR. EMPTY(DBC())
Return .F.
ENDIF
m.lcSafety = "Set Safety "+Set("safety")
Set Safety Off
List Views To FILE _view.tmp NOCONSOLE
If ":"+ALLTRIM(Lower(lcName))+"(" $ STRTRAN(Lower(Filetostr("_view.tmp"))," ","")
Use (lcName) In 0
Endif
&lcSafety
RETURN USED(m.lcName)
*========================================================================================
* Displays a popup with all the values from taList, lets the user incrementally approach
* the desired item and inserts it into the editor.
*========================================================================================
Procedure DisplayPopup
LParameter toISX
Local loPopupForm
If toISX.nCount > 0
loPopupForm = CreateObject( "isxForm", toISX )
If VarType(m.loPopupForm) == "O"
loPopupForm.Show()
Endif
loPopupForm = NULL
EndIf
Clear Class isxForm
EndProc
*====================================================================
* Determines the source of the window identified by the passed
* WHandle. It returns the following values:
*
* -1 The window is not an edit window
* 0 Command Window
* 1 MODIFY COMMAND window
* 2 MODIFY FILE window
* 8 Menu Designer code window
* 10 Method Edit Window in Class or Form Designer
* 12 MODIFY PROCEDURE window
*
* This procedure uses _EdGetEnv() from the FoxTools.Fll to determine
* the edit source. Passing an invalid handle causes an exception in
* VFP 5 and VFP 3. In VFP 6 this raises an error 2028 (API function
* caused an exception). Therefore we return -1 in this case, too.
*====================================================================
Procedure GetEditSource
LParameter tnWHandle
Local laEnv[25], lnSource, lnOK, lcError
lcError = On( "Error" )
On Error lnOK = 0
lnOK = _EdGetEnv( m.tnWHandle, @laEnv )
On Error &lcError
If m.lnOK == 0
lnSource = -1
Else
lnSource = laEnv[25]
Endif
Return m.lnSource
*====================================================================
* Returns the WHandle of the current edit window or 0, if no edit
* window is available.
*====================================================================
Procedure GetCurrentWindow
Local lnWindowOnTop
lnWindowOnTop = _WOnTop()
If m.lnWindowOnTop <= 0
Return 0
Endif
If GetEditSource( m.lnWindowOnTop ) == -1
lnWindowOnTop = 0
Endif
Return m.lnWindowOnTop
*====================================================================
* Returns the current cursor position in the edit window identified
* by the WHandle. On error -1 is returned.
*====================================================================
Procedure GetFileCursorPos
Lparameters tnWHandle
Local lnCursorPos
lnCursorPos = _EdGetPos( m.tnWHandle )
Return m.lnCursorPos
*====================================================================
* Changes the current cursor position in the edit window identified
* by the WHandle.
*====================================================================
Procedure SetFileCursorPos
LParameter tnWHandle, tnPosition
_EdSetPos( m.tnWHandle, m.tnPosition )
EndProc
*====================================================================
* Returns the current line of the edit window identified by the
* WHandle. The line number is zero based. On Error -1 is returned.
*====================================================================
Procedure GetCurrentLine
LParameters tnWHandle
Local lnCursorPos, lnLineNo
lnCursorPos = GetFileCursorPos( m.tnWHandle )
If lnCursorPos < 0
lnLineNo = -1
Else
lnLineNo = _EdGetLNum( m.tnWhandle, m.lnCursorPos )
Endif
Return m.lnLineNo
*====================================================================
* Returns the cursor position within the current line of the edit
* window identified by the WHandle. The cursor position is 0 based.
* On error -1 is returned.
*====================================================================
Procedure GetCurrentCol
Lparameters tnWHandle
Local lnCursorPos, lnLineNo, lnColumn, lnLineStart
lnCursorPos = GetFileCursorPos( m.tnWHandle )
If m.lnCursorPos < 0
Return -1
Endif
lnLineNo = GetCurrentLine( m.tnWHandle )
If m.lnLineNo < 0
Return -1
Endif
lnLineStart = GetLineStart( m.tnWHandle, m.lnLineNo )
lnColumn = m.lnCursorPos - m.lnLineStart
Return m.lnColumn
*====================================================================
* Returns the beginning of the specific line in the edit window
* identified by WHandle. Returns -1 on error.
*====================================================================
Procedure GetLineStart
LParameter tnWHandle, tnLineNo
Local lnLineStart
lnLineStart = _EdGetLPos( m.tnWHandle, m.tnLineNo )
Return m.lnLineStart
*====================================================================
* Returns the text of the specified line in the edit window
* identified by the WHandle. A terminating carriage return is
* removed. Returns an empty string on error. The line must be zero
* based.
*====================================================================
Procedure GetLine
Lparameters tnWHandle, tnLine
Local lnStartPos, lnEndPos, lcString
lnStartPos = GetLineStart( m.tnWHandle, m.tnLine )
lnEndPos = GetLineStart( m.tnWHandle, m.tnLine+1 )
If m.lnStartPos == m.lnEndPos
lcString = ""
Else
lnEndPos = m.lnEndPos - 1
lcString = _EdGetStr( m.tnWHandle, m.lnStartPos, m.lnEndPos )
lcString = Chrtran( m.lcString, Chr(13), "" )
Endif
Return m.lcString
*====================================================================
* Returns the text in the current line that is to the left of the
* cursor in the edit window identified by the WHandle. Returns "" on
* error.
*====================================================================
Procedure GetLineLeftFromCursor
Lparameters tnWHandle
Local lnCurLine, lnCurCol, lcLine
lnCurLine = GetCurrentLine( m.tnWHandle )
If m.lnCurLine < 0
Return ""
Endif
lnCurCol = GetCurrentCol( m.tnWHandle )
If m.lnCurCol < 0
Return ""
Endif
If m.lnCurCol == 0
lcLine = ""
Else
lcLine = GetLine( m.tnWHandle, m.lnCurLine )
lcLine = Left( m.lcLine, m.lnCurCol )
Endif
Return m.lcLine
*====================================================================
* Inserts text in the edit window identified by WHandle. The text is
* stored in tcText, the position is optional. tcOptions can contains
* a combination of the following values:
*
* R The current selection is replaced
* B The cursor is positioned at the beginning of the inserted
* text.
* E (default) The cursor is positioned at the end of the inserted
* text.
* H The inserted text is highlighted.
*====================================================================
Procedure InsertText
Lparameters tnWHandle, tcText, tnPosition, tcOptions
*-----------------------------------------------------------------
* Normalize options
*-----------------------------------------------------------------
Local lcOptions
If Vartype(m.tcOptions) == "C"
lcOptions = Upper( Alltrim(m.tcOptions) )
Else
lcOptions = ""
Endif
*-----------------------------------------------------------------
* If a position is passed, Change the current cursor position
* accordingly.
*-----------------------------------------------------------------
If Vartype(m.tnPosition) == "N"
SetFileCursorPos( m.tnWHandle, m.tnPosition )
Endif
*-----------------------------------------------------------------
* Insert the Text at the current position. If the "R" option is
* used, delete the current selection.
*-----------------------------------------------------------------
Local lnStartPosition, lnEndPosition
If "R" $ m.lcOptions
_EdDelete( m.tnWHandle )
Endif
lnStartPosition = GetFileCursorPos( m.tnWHandle )
_EdInsert( m.tnWHandle, m.tcText, Len(m.tcText) )
lnEndPosition = GetFileCursorPos( m.tnWHandle )
*-----------------------------------------------------------------
* Set the cursor accordingly. "E" is the default of VFP. We don't
* need any action for that.
*-----------------------------------------------------------------
Do Case
Case "B" $ m.lcOptions
SetFileCursorPos( m.tnWHandle, m.lnStartPosition )
Case "H" $ m.lcOptions
_EdSelect( m.tnWHandle, m.lnStartPosition, m.lnEndPosition )
Endcase
EndProc
*========================================================================================
* Fills an array with all variable declarations in the current procedure of the edit
* window identified by the WHandle. Variable declarations are only searched backward from
* the current position. Returns the number of variables.
*
*! 2004-10Oct-19 ChrisW
* Added support for variables with non-english characters such as "�".
* In VFP 9 the array limitation has been lifted.
*========================================================================================
Procedure CP_Variables
Lparameters toISX
*--------------------------------------------------------------------------------------
* Check if the current entity is a variable
*--------------------------------------------------------------------------------------
Local llIsVariable
DO Case
Case Upper(toISX.cEntity)=="M"
llIsVariable = .T.
Case Empty(m.toISX.cEntity)
If Empty(toISX.cInvocation)
llIsVariable = .T.
Else
llIsVariable = .F.
EndIf
Otherwise
llIsVariable = .F.
EndCase
If not m.llIsVariable
Return
EndIf
*-----------------------------------------------------------------
* Get the current line as a starting point. We start with the line
* before that line.
*-----------------------------------------------------------------
Local lnEnd
lnEnd = GetCurrentLine( toISX.nWHandle )
If lnEnd <= 0
Return
Else
lnEnd = m.lnEnd - 1
Endif
*-----------------------------------------------------------------
* Because GetLine() is quite slow with large program files, we
* read the entire program up to the line before the current line
* into an array and parse that. Since an array can only contain
* up to 65000 lines, we make sure that we don't read more than
* that into the laText array.
*-----------------------------------------------------------------
Local lnLineCount, laText[1], lnStart
If m.lnEnd >= 65000 and Version(4) < "09.00"
lnStart = m.lnEnd - 65000
Else
lnStart = 0
Endif
lnLineCount = AGetLines(m.toISX.nWHandle,@laText,m.lnStart,m.lnEnd)
*--------------------------------------------------------------------------------------
* Parse all lines backwards for the following keywords: LOCAL,
* PUBLIC, PROCEDURE, FUNCTION. We add all variables in the
* LOCAL and PUBLIC lines and stop parsing when we find PROCEDURE
* or FUNCTION.
*--------------------------------------------------------------------------------------
Local lnCurrentLine, lcLine, lnPos, lcCommand, lcValidCmds
For lnCurrentLine = m.lnLineCount to 1 Step -1
lcLine = NormalizeLine( laText[m.lnCurrentLine] )
If Len(m.lcLine) < 4
Loop
EndIf
If Version(4) >= "07.00"
lcCommand = GetWordNum(m.lcLine,2)
Else
lcCommand = X6_GetWordNum(m.lcLine,2)
EndIf
If m.lcCommand == "="
Loop
EndIf
If Version(4) >= "07.00"
lcCommand = GetWordNum(m.lcLine,1)
Else
lcCommand = X6_GetWordNum(m.lcLine,1)
EndIf
lcValidCmds = ;
"LOCAL,PUBLIC,LPARAMETERS,PARAMETERS,PRIVATE,PROCEDURE,FUNCTION,PROTECTED," + ;
"HIDDEN"
If not IsFoxProCommand(m.lcCommand,m.lcValidCmds)
Loop
EndIf
lnPos = At( " ", m.lcLine )
If m.lnPos == 0 or m.lnPos == Len(m.lcLine)
Loop
Endif
lcLine = Alltrim( Substr(m.lcLine,m.lnPos) )
If IsFoxProCommand(m.lcCommand,"LOCAL")
If Version(4) >= "07.00"
lcCommand = GetWordNum(m.lcLine,1)
Else
lcCommand = X6_GetWordNum(m.lcLine,1)
EndIf
If IsFoxProCommand(m.lcCommand,"ARRAY")
lnPos = At( " ", m.lcLine )
If m.lnPos == 0 or m.lnPos == Len(m.lcLine)
Loop
Endif
lcLine = Alltrim( Substr(m.lcLine,m.lnPos) )
EndIf
EndIf
If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION,PROTECTED,HIDDEN" )
lnPos = At( "(", m.lcLine )
If m.lnPos == 0 or m.lnPos == Len(m.lcLine)
Exit
EndIf
lcLine = Substr(m.lcLine,m.lnPos+1)
EndIf
lnCurrentLine = m.lnCurrentLine - ;
CP_VariablesAdd( m.toISX, m.lcLine, m.lnCurrentLine, @laText )
If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION,PROTECTED,HIDDEN" )
Exit
Endif
Endfor
EndProc
*========================================================================================
*
*========================================================================================
Procedure CP_VariablesAdd
LParameter toISX, tcLine, tnCurrentLine, taText
Local lcLine, lnLineOffset, lnCurrentVar, laDeclarations[1], lcCurrentVar, ;
lnPosInVar, lcChar, lnPos
lcLine = m.tcLine
lnLineOffset = 0
Do While .T.
lcLine = Chrtran( m.lcLine, ",", Chr(13) )
For lnCurrentVar = 1 to ALines( laDeclarations, lcLine )
lcCurrentVar = Alltrim( laDeclarations[m.lnCurrentVar] )
If Empty( m.lcCurrentVar )
Loop
Endif
If not IsAlpha( m.lcCurrentVar ) ;
and not Left(m.lcCurrentVar,1) == "_"
Loop
Endif
lnPos = At( " ", m.lcCurrentVar )
If m.lnPos == 0
lnPos = Len( m.lcCurrentVar )
Else
lnPos = m.lnPos - 1
Endif
lcCurrentVar = Left( m.lcCurrentVar, m.lnPos )
If LEFT(LOWER(m.lcCurrentVar),2)=='m.'
lcCurrentVar = SUBSTR(m.lcCurrentVar,3)
EndIf
For m.lnPosInVar = 2 to Len(m.lcCurrentVar)
lcChar = SubStr(m.lcCurrentVar,m.lnPosInVar,1)
If not (IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar="_")
lcCurrentVar = Left( m.lcCurrentVar, m.lnPosInVar-1 )
Exit
Endif
Endfor
toISX.nCount = m.toISX.nCount + 1
Dimension toISX.aList[m.toISX.nCount]
toISX.aList[m.toISX.nCount] = m.lcCurrentVar
Endfor
If Right(m.lcLine,1) # ";"
Exit
Endif
lnLineOffset = m.lnLineOffset + 1
If m.tnCurrentLine + m.lnLineOffset > Alen(taText,1)
Exit
Endif
lcLine = NormalizeLine( ;
taText[m.tnCurrentLine+m.lnLineOffset] ;
)
Enddo
Return m.lnLineOffset
*========================================================================================
* Returns .T., when the first string is a FoxPro command.
*========================================================================================
Procedure IsFoxProCommand
LParameter tcCommand, tcCommandList
Local laList[1], lnLine, llFound
llFound = .F.
For lnLine=1 to ALines(laList,Chrtran(m.tcCommandList,",",Chr(13)+Chr(10)))
If Left(Upper(laList[m.lnLine]),Len(m.tcCommand)) == Upper(m.tcCommand)
llFound = .T.
Exit
Endif
EndFor
Return m.llFound
*====================================================================
* Normalizes a line. This means: All tabs are converted to single
* blanks, leading or trailing blanks are removed. Comments starting
* with && are removed.
*====================================================================
Procedure NormalizeLine
Lparameters tcLine
Local lcLine, lnPos
lcLine = Chrtran( m.tcLine, Chr(9), " " )
If "&"+"&" $ m.lcLine
lnPos = At( "&"+"&", m.lcLine )
lcLine = Left( m.lcLine, m.lnPos-1 )
Endif
lcLine = Alltrim(m.lcLine)
Return m.lcLine
*====================================================================
* GetKeyLabel takes the parameters passed to the KeyPress event and
* returns the label name that can be used for KEYBOARD or ON KEY
* LABEL, etc.
*====================================================================
Procedure GetKeyLabel
LParameter tnKeyCode, tnSAC
Local lcLabel
Do Case
Case Between(m.tnKeyCode,33,126)
lcLabel = Chr(m.tnKeyCode)
Case Between(m.tnKeyCode,128,255)
lcLabel = Chr(m.tnKeyCode)
Case m.tnSAC == 2 and Between(m.tnKeyCode,1,26)
Do Case
Case m.tnKeyCode == 2
lcLabel = "CTRL+RIGHTARROW"
Case m.tnKeyCode == 8
lcLabel = ""
Case m.tnKeyCode == 10
lcLabel = "CTRL+ENTER"
Case m.tnKeyCode == 23
lcLabel = "CTRL+END"
Case m.tnKeyCode == 26
lcLabel = "CTRL+LEFTARROW"
Otherwise
lcLabel = "CTRL+" + Chr(m.tnKeyCode+64)
Endcase
Case m.tnSAC == 0 and m.tnKeyCode < 0
lcLabel = "F" + Alltrim(Str(Abs(m.tnKeyCode)+1))
Case m.tnSAC == 0 and m.tnKeyCode == 22
lcLabel = "INS"
Case m.tnSAC == 1 and m.tnKeyCode == 22
lcLabel = "SHIFT+INS"
Case m.tnSAC == 0 and m.tnKeyCode == 1
lcLabel = "HOME"
Case m.tnSAC == 0 and m.tnKeyCode == 7
lcLabel = "DEL"
Case m.tnSAC == 0 and m.tnKeyCode == 28
lcLabel = "F1"
Case m.tnSAC == 0 and m.tnKeyCode == 6
lcLabel = "END"
Case m.tnSAC == 0 and m.tnKeyCode == 18
lcLabel = "PGUP"
Case m.tnSAC == 0 and m.tnKeyCode == 3
lcLabel = "PGDN"
Case m.tnSAC == 0 and m.tnKeyCode == 5
lcLabel = "UPARROW"
Case m.tnSAC == 0 and m.tnKeyCode == 28
lcLabel = "F1"
Case m.tnSAC == 0 and m.tnKeyCode == 24
lcLabel = "DNARROW"
Case m.tnSAC == 0 and m.tnKeyCode == 4
lcLabel = "RIGHTARROW"
Case m.tnSAC == 0 and m.tnKeyCode == 19
lcLabel = "LEFTARROW"
Case m.tnSAC == 0 and m.tnKeyCode == 27
lcLabel = "ESC"
Case m.tnSAC == 0 and m.tnKeyCode == 13
lcLabel = "ENTER"
Case m.tnSAC == 0 and m.tnKeyCode == 127
lcLabel = "BACKSPACE"
Case m.tnSAC == 0 and m.tnKeyCode == 9
lcLabel = "TAB"
Case m.tnSAC == 0 and m.tnKeyCode == 32
lcLabel = "SPACEBAR"
Case m.tnSAC == 1 and m.tnKeyCode == 13
lcLabel = "SHIFT+ENTER"
Case m.tnSAC == 1 and m.tnKeyCode == 127
lcLabel = "SHIFT+BACKSPACE"
Case m.tnSAC == 1 and m.tnKeyCode == 15
lcLabel = "SHIFT+TAB"
Case m.tnSAC == 1 and m.tnKeyCode == 32
lcLabel = "SHIFT+SPACEBAR"
Case m.tnSAC == 2 and m.tnKeyCode == 29
lcLabel = "CTRL+HOME"
Case m.tnSAC == 2 and m.tnKeyCode == 31
lcLabel = "CTRL+PGUP"
Case m.tnSAC == 2 and m.tnKeyCode == 30
lcLabel = "CTRL+PGDN"
Case m.tnSAC == 2 and m.tnKeyCode == 128
lcLabel = "CTRL+BACKSPACE"
Case m.tnSAC == 2 and m.tnKeyCode == 32
lcLabel = "CTRL+SPACEBAR"
Otherwise
lcLabel = ""
Endcase
Return m.lcLabel
*====================================================================
* Fills an array with all lines between nStart and nEnd.
*====================================================================
Procedure AGetLines
LParameter tnWHandle, raText, tnStart, tnEnd
*-----------------------------------------------------------------
* Copy the text between nStart and nEnd into a string variable.
*-----------------------------------------------------------------
Local lnStartPos, lnEndPos, lcString
lnStartPos = GetLineStart( m.tnWHandle, m.tnStart )
lnEndPos = GetLineStart( m.tnWHandle, m.tnEnd+1 ) - 1
lcString = _EdGetStr( m.tnWHandle, m.lnStartPos, m.lnEndPos )
*-----------------------------------------------------------------
* And parse this into an array
*-----------------------------------------------------------------
Local lnCount
lnCount = ALines( raText, m.lcString )
Return m.lnCount
*====================================================================
* The FoxTools function _AGetEnv() doesn't return proper font infor-
* mation. Instead it claims that "MS Sans Serif", 8 pt. is the
* current font. This function returns font information for the speci-
* fied window by accessing the GDI.
*====================================================================
Procedure WGetFontInfo
LParameter tnWHandle, rcFontName, rnFontSize, rnStyle
*-----------------------------------------------------------------
* In addition to the window handle of this window we also need
* the HWND of the child window that contains the actual editor.
* The GetClientWindow() function retrieves this window handle.
*-----------------------------------------------------------------
Local lnHWND
lnHWND = GetClientWindow( m.tnWHandle )
If m.lnHWND == 0
Return .F.
Endif
*-----------------------------------------------------------------
* Using this HWND we can then get a Device Context.
*-----------------------------------------------------------------
Local lnHWND, lnHDC
Declare LONG GetDC in Win32API LONG
lnHDC = GetDC( m.lnHWND )
If m.lnHDC == 0
Return .F.
Endif
*-----------------------------------------------------------------
* With this device context we can now get an object handle to the
* currently selected font.
*-----------------------------------------------------------------
Local lnHFONT
Declare LONG GetCurrentObject in Win32API LONG, LONG
lnHFONT = GetCurrentObject( m.lnHDC, 6 ) && OBJ_FONT
If m.lnHFONT == 0
Return .F.
Endif
*-----------------------------------------------------------------
* The HFONT handle to the current font can be used to obtain more
* detailled information about the selected font. We need to rename
* the API function GetObject(), because it interferes with VFP's
* GETOBJECT() function
*-----------------------------------------------------------------
Local lcLogFont
Declare Integer GetObject in Win32API as GDI_GetObject ;
LONG, Integer, String@
lcLogFont = Replicate( Chr(0), 1024 )
If GDI_GetObject( m.lnHFONT, 1024, @lcLogFont ) == 0
Return .F.
Endif
*-----------------------------------------------------------------
* Now to extract the font information from the LOGFONT structure.
*-----------------------------------------------------------------
Local lnSize, lcName, lnStyle
lnSize = Abs( FromInt(Left(m.lcLogFont,4)) - 2^32 )
lcName = SubStr( m.lcLogFont, 29 )
lcName = Left( m.lcName, At(Chr(0),m.lcName)-1 )
lnStyle = 0
If FromInt(SubStr(m.lcLogFont,17,4)) == 700
lnStyle = m.lnStyle + 1
Endif
If FromInt(SubStr(m.lcLogFont,21,4)) # 0
lnStyle = m.lnStyle + 2
Endif
*-----------------------------------------------------------------
* We now have the height of the font in pixels but what we need
* are points.
*-----------------------------------------------------------------
Local lnResolution
Declare Integer GetDeviceCaps in Win32API Integer, Integer
lnResolution = GetDeviceCaps( m.lnHDC, 90 ) && LOGPIXELSY
lnSize = m.lnSize / m.lnResolution * 72
lnSize = Round( m.lnSize, 0 )
*-----------------------------------------------------------------
* Finally release the device context
*-----------------------------------------------------------------
Declare Integer ReleaseDC In Win32API LONG, LONG
ReleaseDC( m.lnHWND, m.lnHDC )
*-----------------------------------------------------------------
* And pass the values pack as parameters
*-----------------------------------------------------------------
rcFontName = m.lcName
rnFontSize = m.lnSize
rnStyle = m.lnStyle
Return .T.
*====================================================================
* The editor only works on the editor window and you can only get the
* HWND of this window using the Window Handle. For many Windows ope-
* rations, however, you need the HWND of the child window that con-
* tains the actual editor area. This function returns the HWND of
* this window. It's not that easy, because Method snippet windows
* actually have two child windows, one for the text editor and one
* with the method and object dropdown combos.
*====================================================================
Procedure GetClientWindow
LParameter tnWHandle
*-----------------------------------------------------------------
* Convert the Window Handle into a HWND
*-----------------------------------------------------------------
Local lnHWND
lnHWND = _WhToHWND( m.tnWHandle )
*-----------------------------------------------------------------
* FindWindowEx returns all child windows of a given parent window.
* We use it to find a child of the edit window that doesn't have
* another child window, because method edit windows have a second
* which we can identify since it has another child window.
*-----------------------------------------------------------------
Local lnChild
Declare Integer FindWindowEx in Win32API ;
Integer, Integer, String, String
lnChild = 0
Do While .T.
lnChild = FindWindowEx( m.lnHWND, m.lnChild, NULL, NULL )
If m.lnChild == 0
Exit
Endif
If FindWindowEx( m.lnChild, 0, NULL, NULL ) == 0
Exit
Endif
Enddo
Return m.lnChild
*====================================================================
* Returns the position of the text cursor (caret) in _SCREEN coordi-
* nates. If the window identified by the passed window handle doesn't
* have the focus, or the position can't be determined, this function
* returns .F.
*====================================================================
Procedure GetCaretPosition
LParameter tnWHandle, rnTop, rnLeft
*-----------------------------------------------------------------
* Check whether this window has got the focus.
*-----------------------------------------------------------------
Declare Integer GetFocus in Win32API
If GetFocus() # _WhToHWND( m.tnWHandle )
Return .F.
Endif
*-----------------------------------------------------------------
* Determine the cursor position. This position is relative to the
** OK
* client area of the editing subwindow of the actual editing win-
* dow.
*-----------------------------------------------------------------
Local lnLeft, lnTop, lcPOINT
Declare Integer GetCaretPos in Win32API String@
lcPOINT = Space(8)
If GetCaretPos( @lcPOINT ) == 0
lnLeft = MCol(3)
lnTop = MRow(3)
Else
lnLeft = Asc(Left(m.lcPOINT,1))+256*Asc(SubSTr(m.lcPOINT,2,1))
lnTop = Asc(SubSTr(m.lcPOINT,5,1))+256*Asc(SubStr(m.lcPOINT,6,1))
Endif
*-----------------------------------------------------------------
* To convert this postion to _SCREEN coordinates, we have to
* determine the position of the client window relative to the
* desktop window and correlate this with the absolute position of
* the _SCREEN window. Hence, we need first the HWNDs of both
* windows.
*-----------------------------------------------------------------
Local lnChild, lnScreen
Declare Integer GetParent in Win32API Integer
lnChild = GetClientWindow( m.tnWHandle )
If m.lnChild == 0
Return .F.
Endif
lnScreen = GetParent( _WhToHWND(m.tnWHandle) )
If m.lnScreen == 0
Return .F.
Endif
*-----------------------------------------------------------------
* Now we can determine the position of both windows.
*-----------------------------------------------------------------
Local lnChildTop, lnChildLeft, lnScreenTop, lnScreenLeft, lcRect
lcRect = Replicate( Chr(0), 16 )
Declare Integer GetWindowRect in Win32API Long, String@
GetWindowRect( m.lnChild, @lcRect )
lnChildLeft = FromInt( Left(m.lcRect,4) )
lnChildTop = FromInt( SubSTr(m.lcRect,5,4) )
GetWindowRect( m.lnScreen, @lcRect )
lnScreenLeft = FromInt( Left(m.lcRect,4) )
lnScreenTop = FromInt( SubSTr(m.lcRect,5,4) )
*-----------------------------------------------------------------
* Now combine the position of the edit window and the cursor
* position.
*-----------------------------------------------------------------
rnLeft = m.lnLeft + m.lnChildLeft - m.lnScreenLeft
rnTop = m.lnTop + m.lnChildTop - m.lnScreenTop
EndProc
Procedure FromInt
Parameter tcString
Private nValue, nT
nValue =0
For nT = 1 to Len(tcString)
nValue = nValue + Asc(SubStr(tcString,nT,1))*256^(nT-1)
Endfor
Return nValue
*====================================================================
* The following class displays a popup window at the current cursor
* position and lets the user continue to type.
*
* The characters a-z, A-Z, 0-9 and _ are inserted into the active
* edit window as the user types. The previous position is saved in
* order to restore the text if necessary.
*
* ESC terminates the popup and doesn't change the text.
*
* TAB inserts the current selection and terminates the popup.
*
* SPACEBAR inserts the current selection, adds a blank and terminates
* the popup.
*
* Any other key terminates the popup and is repeated so it is handled
* properly by VFP. If the user enters the first character that
* doesn't match an item in the list, or entered a full item where
* none exists that has the same name, but additional characters, the
* list is terminated as well.
*
*====================================================================
Define CLASS isxForm as Form
AlwaysOnTop = .T.
WindowType = 1
TitleBar = 0
BorderStyle = 0
nWHandle = 0
nCurrentPos = 0
cSearchString = ""
cVarString = ""
Dimension aItems[1,2]
lScrolled = .F.
*Mike Yearwood - these support reducing screen caption flicker
cScreenCaption = ""
cWindowCaption = ""
lMaximized = .F.
Add Object isxList as Listbox with ;
ColumnCount = 2, ;
ColumnLines = .F., ;
IncrementalSearch = .F.
PROCEDURE Load
this.lMaximized = wmaximum()
IF THIS.lMaximized
THIS.cWindowCaption = LOWER(WTITLE())
THIS.cScreenCaption = _screen.Caption
ENDIF
RETURN DODEFAULT()
ENDPROC
PROCEDURE Show
*====================================================================
* Mike Yearwood
* When the edit window is maximized, the screen caption reads
* currentedit.prg * - current vfp system window caption
* When this window goes active, the screen caption changes
* which causes a flicker. To stop that flicker, set the screen
* caption to what it was before.
*====================================================================
IF THIS.lMaximized
_Screen.Caption = this.cWindowCaption + " * - " + this.cScreenCaption
ENDIF
ENDPROC
PROCEDURE Destroy
*Mike Yearwood
*Prevent screen caption flicker.
IF THIS.lMaximized
_Screen.Caption = this.cScreenCaption
ENDIF
ENDPROC
*====================================================================
* When the form is initialized, we have to determine its position
* and get a handle to the current edit window. Pass an array to this
* form that contains all possible values the user can enter.
*====================================================================
Procedure Init
LParameter toISX
With This
*-----------------------------------------------------------------
* Get the handle for the current window.
*-----------------------------------------------------------------
.nWHandle = toISX.nWHandle
.nCurrentPos = GetFileCursorPos( .nWHandle )
*-----------------------------------------------------------------
* Copy the array and sort it case-insensitive
*-----------------------------------------------------------------
Local laValues[1], lnValue
If Version(4) >= "07.00"
Asort( toISX.aList, -1, -1, 0, 1 )
Else
Dimension laValues[toISX.nCount,2]
For lnValue = 1 to toISX.nCount
laValues[m.lnValue,1] = Upper(toISX.aList[m.lnValue])
laValues[m.lnValue,2] = m.lnValue
EndFor
Asort( laValues, 1 )
EndIf
*--------------------------------------------------------------------------------------
* Fill the listbox with all possible values.
*--------------------------------------------------------------------------------------
Local lcValue, lnWidth, lnMaxWidth, lnValue, lcVarString, lnAvgCharWidth
lnMaxWidth = 0
lcVarString = ""
Dimension .aItems[toISX.nCount,2]
lnAvgCharWidth = Fontmetric(6,.isxList.FontName,.isxList.FontSize)
For lnValue = 1 to toISX.nCount
If Version(4) >= "07.00"
lcValue = toISX.aList[m.lnValue]
Else
lcValue = toISX.aList[laValues[m.lnValue,2]]
EndIf
.aItems[m.lnValue,1] = Upper(m.lcValue)
.aItems[m.lnValue,2] = m.lcValue
lcVarString = m.lcVarString + ":" + Padr(Upper(m.lcValue),128)
lnWidth = Txtwidth(m.lcValue,.isxList.FontName,.isxList.FontSize) * m.lnAvgCharWidth
lnMaxWidth = Max( m.lnMaxWidth, m.lnWidth )
EndFor
.cVarString = m.lcVarString
lnMaxWidth = m.lnMaxWidth + 30
With .isxList
.ColumnWidths = "0," + Alltrim(Str(m.lnMaxWidth))
.RowSource = "Thisform.aItems"
.RowSourceType = 5
.Requery()
.Move( 0, 0, m.lnMaxWidth, 110 )
If .ListCount < 6
.Height = .ListCount*16 + 14
Endif
EndWith
.Width = m.lnMaxWidth
.Height = .isxList.Height
*-----------------------------------------------------------------
* The original version of the following few code blocks has been
* kindly provided by Louis D. Zelus. I've modified it to match the
* rest of the code here. The purpose is to simulate a behavior
* in VB. If the variable is inserted via ALT+I, everything already
* typed is used to position the list and if the already entered
* parts are sufficient to uniquely identify the variablem it's
* inserted without displaying the popup at all. All blocks based
* on his code start with LDZ.
*-----------------------------------------------------------------
*-----------------------------------------------------------------
* LDZ: If a variable name has been entered, we highlight it in the
* edit window.
*-----------------------------------------------------------------
Local lnStartPos, lnEndPos, lcInput
lcInput = toISX.cName
If Len(m.lcInput) > 0
lnEndPos = GetFileCursorPos( .nWHandle )
lnStartPos = m.lnEndPos - Len(m.lcInput)
_EdSelect( .nWHandle, m.lnStartPos, m.lnEndPos )
Endif
*-----------------------------------------------------------------
* LDZ: Try to find this variable name in the list of variables we
* assembled above. If we find it, we select this entry and save
* what has been entered so far.
*-----------------------------------------------------------------
Local lnIndex
If Len(m.lcInput) > 0
lnIndex = At( ":"+Upper(m.lcInput), .cVarString )
If m.lnIndex == 0
.isxlist.ListIndex = 0
Else
.isxlist.ListIndex = (m.lnIndex/129) + 1
Endif
.cSearchString = m.lcInput
Endif
*-----------------------------------------------------------------
* LDZ: If there's no second instance of this start, accept it
* immediately without displaying the popup. The full variable name
* is inserted with the proper case at the current position
* replacing the selection.
*-----------------------------------------------------------------
If Len(m.lcInput) > 0
If At( ":"+Upper(m.lcInput), .cVarString, 2 ) == 0 ;
and not m.lnIndex == 0
InsertText( .nWHandle, "", , "R" )
InsertText( .nWHandle, .isxList.List[.isxList.ListIndex,2] )
Return .F.
Endif
Endif
*-----------------------------------------------------------------
* Determine the cursor position in _SCREEN coordinates
*-----------------------------------------------------------------
Local lnLeft, lnTop
If not GetCaretPosition( .nWHandle, @lnTop, @lnLeft )
Return .F.
Endif
*-----------------------------------------------------------------
* As we position the popup BELOW the current line, we need to
* know the height of this line in pixels.
*-----------------------------------------------------------------
Local lnLineHeight, lnAvgCharWidth, lcFontName, lnFontSize
If not WGetFontInfo( .nWHAndle, @lcFontName, @lnFontSize )
Return .F.
Endif
lnLineHeight = FontMetric( 1, m.lcFontName, m.lnFontSize )
lnAvgCharWidth = FontMetric(6,m.lcFontName,m.lnFontSize)
*-----------------------------------------------------------------
* We make sure that the popup doesn't move below the VFP window to
* keep it visible all the time. If it doesn't fit into the area
* below the cursor, we move it upwards.
*-----------------------------------------------------------------
If m.lnTop + .Height + m.lnLineHeight > _Screen.Height
lnTop = m.lnTop - .Height
Else
lnTop = m.lnTop + m.lnLineHeight
Endif
.Top = m.lnTop
*------------------------------------------------------------------
* As for the height of the VFP window, we do the same for the
* width. If the popup won't fit into the VFP _Screen, we flip
* it horizontally.
*------------------------------------------------------------------
If m.lnLeft + .Width + lnAvgCharWidth > _Screen.Width
lnLeft = m.lnLeft - .Width
Else
lnLeft = m.lnLeft + lnAvgCharWidth
EndIf
.Left = m.lnLeft
Endwith
EndProc
*========================================================================================
* If we don't hide the popup before releasing it, the focus might not go back to the
* edit window. This happens when we have a Data Session window docked on one side and
* a code editing window maximized. In this case the focus switches to the datasession
* window and Aliases listbox disappears.
*========================================================================================
Procedure Release
This.Hide()
EndProc
Procedure isxList.KeyPress
LParameter tnKeyCode, tnSAC
With This
*-----------------------------------------------------------------
* If the Up or Down Arrow has been pressed, we do nothing, but
* remember that the user scrolled in the list, because this acti-
* vates the enter key.
*-----------------------------------------------------------------
Local llScrolled
If m.tnSAC == 0 and InList( m.tnKeyCode, 5, 24 )
.Parent.lScrolled = .T.
Return
Endif
llScrolled = .Parent.lScrolled
.Parent.lScrolled = .F.
*-----------------------------------------------------------------
* Determines whether a name qualifier has been entered.
*-----------------------------------------------------------------
Local llQualifier
llQualifier = .F.
If m.tnSAC == 0 and Between(m.tnKeyCode,Asc("a"),Asc("z"))
llQualifier = .T.
Endif
If m.tnSAC == 1 and Between(m.tnKeyCode,Asc("A"),Asc("Z"))
llQualifier = .T.
Endif
If m.tnSAC == 0 and Between(m.tnKeyCode,Asc("0"),Asc("9"))
llQualifier = .T.
Endif
If m.tnSAC == 1 and m.tnKeyCode == Asc("_")
llQualifier = .T.
Endif
*-----------------------------------------------------------------
* If a qualifier has been entered, we insert the character into
* the current edit window. We also perform an incremental search
* on the Text being inserted.
*-----------------------------------------------------------------
Local lcSearch, lnIndex
If m.llQualifier
lcSearch = .Parent.cSearchString + Chr(m.tnKeyCode)
Endif
*-----------------------------------------------------------------
* BACKSPACE deletes the last character.
*-----------------------------------------------------------------
If m.tnSAC == 0 and m.tnKeyCode == 127
If Len(.Parent.cSearchString) > 0
lcSearch = .Parent.cSearchString
lcSearch = Left( m.lcSearch, Len(m.lcSearch)-1 )
llQualifier = .T.
Endif
Endif
*-----------------------------------------------------------------
* Now that we handled BACKSPACE, we can update the variable name
* in the edit window.
*-----------------------------------------------------------------
If m.llQualifier
InsertText( .Parent.nWHandle, m.lcSearch, , "RH" )
lnIndex = At( ":"+Upper(m.lcSearch), .Parent.cVarString )
If m.lnIndex == 0
.ListIndex = 0
Else
.ListIndex = (m.lnIndex/129) + 1
Endif
.Parent.cSearchString = m.lcSearch
NoDefault
Return
Endif
*-----------------------------------------------------------------
* The following flags determine how to procede.
*-----------------------------------------------------------------
Local lcTextToInsert, llResendKey, llClearInput
lcTextToInsert = ""
llResendKey = .T.
llClearInput = .F.
Do Case
*-----------------------------------------------------------------
* If TAB has been pressed, insert the current selection and
* release the popup
*-----------------------------------------------------------------
Case m.tnSAC == 0 and m.tnKeyCode == 9 and .ListIndex > 0
lcTextToInsert = .List[.ListIndex,2]
llResendKey = .F.
llClearInput = .T.
*-----------------------------------------------------------------
* If ENTER has been pressed after the user made a selection with
* the arrow keys, we insert the current selection and release the
* popup, because after scrolling the user has the feeling of using
* a plain listbox where enter performs a selection.
*-----------------------------------------------------------------
Case m.tnSAC == 0 ;
and m.tnKeyCode == 13 ;
and .ListIndex > 0 ;
and m.llScrolled
lcTextToInsert = .List[.ListIndex,2]
llResendKey = .F.
llClearInput = .T.
*-----------------------------------------------------------------
* Several keys insert the current selection plus the typed
* character and release the popup. These are usually keys that
* directly follow a variable name.
*-----------------------------------------------------------------
Case InList(m.tnKeyCode, ;
Asc(" "), Asc(")"), Asc("["), Asc("."), Asc("="), ;
Asc("+"), Asc("-"), Asc("*"), Asc("/"), Asc("%"), ;
Asc(","), Asc("]") ;
) and .ListIndex > 0
lcTextToInsert = .List[.ListIndex,2]
llClearInput = .T.
*-----------------------------------------------------------------
* If ESC has been pressed, the text is unselected.
*-----------------------------------------------------------------
Case m.tnSAC == 0 and m.tnKeyCode == 27
llResendKey = .F.
*-----------------------------------------------------------------
* terminate the popup for any other key and leave the text.
*-----------------------------------------------------------------
Otherwise
Endcase
*-----------------------------------------------------------------
* If the currently entered Text should be deleted, insert an empty
* string using the replace option. Insert text afterwards.
*-----------------------------------------------------------------
If m.llClearInput
InsertText( .Parent.nWHandle, "", , "R" )
Else
SetFileCursorPos( ;
.Parent.nWHandle, ;
.Parent.nCurrentPos + Len(.Parent.cSearchString) ;
)
Endif
If not Empty( m.lcTextToInsert )
InsertText( .Parent.nWHandle, m.lcTextToInsert )
Endif
*-----------------------------------------------------------------
* Close the form.
*-----------------------------------------------------------------
NoDefault
Thisform.Release()
*-----------------------------------------------------------------
* And repeat the keystroke if necessary
*-----------------------------------------------------------------
Local lcKey
If m.llResendKey
lcKey = GetKeyLabel( m.tnKeyCode, m.tnSAC )
If not Empty(m.lcKey)
Clear TypeAhead
If Len(m.lcKey) == 1
Keyboard m.lcKey
Else
Keyboard "{"+m.lcKey+"}"
Endif
Endif
Endif
Endwith
EndProc
*====================================================================
* Double-clicking is the same as TAB.
*====================================================================
Procedure isxList.DblClick
Clear TypeAhead
Keyboard "{Tab}" Plain
EndProc
EndDefine
*========================================================================================
* VFP 6: Returns a specific word in a string
*========================================================================================
Function X6_GetWordNum
LParameter tcString, tnWord, tcDelimiter
Local lcString, lcDelimiter, lnWord, laWords[1], lnFound, lcWord
If Vartype(m.tcDelimiter) == "C"
lcDelimiter = m.tcDelimiter
Else
lcDelimiter = Chr(9)+Chr(32)
EndIf
lcString = Chrtran(m.tcString,m.lcDelimiter,Replicate(Chr(13),Len(m.lcDelimiter)))
lnFound = 0
lcWord = ""
For lnWord = 1 to ALines(laWords,m.lcString)
If not Empty(laWords[m.lnWord])
lnFound = lnFound + 1
If m.lnFound == m.tnWord
lcWord = laWords[m.lnWord]
Exit
EndIf
EndIf
EndFor
Return m.lcWord
*========================================================================================
* VFP 6: Returns a list of all defines
*========================================================================================
Procedure X6_AProcInfo
LParameter taArray, tcFile
Local laLines[1], lnLine, lnFound
lnFound = 0
For lnLine = 1 to ALines(laLines,FileToStr(m.tcFile))
If Upper(X6_GetWordNum(laLines[m.lnLine],1)) == "#DEFINE"
lnFound = lnFound + 1
Dimension taArray[m.lnFound,3]
taArray[m.lnFound,1] = X6_GetWordNum(laLines[m.lnLine],2)
taArray[m.lnFound,3] = "Define"
EndIf
EndFor
Return m.lnFound