vfp 智能感知拓展应用

*========================================================================================
*
* 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