Tuesday, December 06, 2005

The problem
Often in code Visual FoxPro developers will find themselves having to save the previous state of something in order to be able to restore it once some code has run. The usual culprits are:

  • SET command (such as SET SAFETY, SET DELETED, etc.)
  • ON command (ON ERROR, ON ESCAPE, etc.)
  • Record Pointer position
  • Selected Work Area

The solution
Rather than writing the same lines of code over and over again in our programs, we could create a class that will handle this. The following is a SettingHandler class I've written and some examples of use. You'll note that when I instantiate the class I send it the command that I'm about to execute (such as SET SAFETY OFF) as a string parameter. The class will save the current Safety setting for me and then set it to OFF. When I want the previous Safety setting restored, I release the instance of SettingHandler and the class will restore Safety to whatever it was prior to my setting it off.

Drawbacks and possible improvements
The only drawback I've found to this approach is that intellisense doesn't work when I am typing in the command as a string parameter. As for improvements, most of the ones I can think of would have to do with table operations. Code could be added to allow you to save the current datasession id and restore to that datasession (there are probably other settings that could be provided for as well - Captions, ForeColor, BackColor, Tag, or whatever). Also, some logic could be added to handle if a developer switched work areas, but hadn't specified the work area in the GOTO command.

Here's a runnable example and class definition (Cut-n-paste the code below into a prg file and execute it)

*************************
*!* EXAMPLES OF USE
*************************
CLEAR
LOCAL loSetting
? "SET COMMANDS:"
SET SAFETY ON
?SET("SAFETY")
loSetting = CREATEOBJECT("SettingHandler", "SET SAFETY OFF") && Safety setting is saved and changed
?SET("SAFETY")
RELEASE loSetting && Previous Safety setting is restored
?SET("SAFETY")
?
? "ON COMMANDS:"
ON ERROR ?"Previous Error Handler"
?ON("ERROR")
loSetting = CREATEOBJECT("SettingHandler", "ON ERROR ?'New Error Handler'") && Error handler is saved and changed
?ON("ERROR")
RELEASE loSetting && Previous Error handler is restored
?ON("ERROR")
?
? "RECORD NUMBER:"
IF !USED("customers")
 USE (HOME(2) + "northwind\customers.dbf") IN 0 SHARED
ENDIF
GOTO 5 IN "customers"
?RECNO("customers")
loSetting = CREATEOBJECT("SettingHandler", "GO 12 in [customers]") && record pointer position is saved and changed
?RECNO("customers")
RELEASE loSetting && record pointer position is restored
?RECNO("customers")
?
? "SELECT:"
IF !USED("orders")
 USE (HOME(2) + "northwind\orders.dbf") IN 0 SHARED
ENDIF
SELECT "Orders"
?ALIAS()
loSetting = CREATEOBJECT("SettingHandler", "Select Customers") && Selected Alias is saved and changed
?ALIAS()
RELEASE loSetting && Previous selected Alias is restored
?ALIAS()
USE IN SELECT("Customers")
USE IN SELECT("Orders")
*********End of Examples************

************************************
*!* CLASS DEFINITION
************************************
DEFINE CLASS SettingHandler as custom
 PROTECTED PreviousValue
 PreviousValue = .NULL.
 
 PROTECTED SettingCommand
 SettingCommand = ""
 
 PROTECTED SettingType && 0 = SET/ON, 1 = RECNO
 SettingType = -1
 
 #DEFINE SETTINGDELIMITERS [('" ] + "[])"
 
 PROCEDURE Init (tcCommand)
  This.Setup(tcCommand)
 ENDPROC
 
 PROTECTED PROCEDURE Destroy
  This.RevertSetting()
 ENDPROC

 PROCEDURE Setup (tcCommand)
  This.SettingCommand = ALLTRIM(tcCommand)
  This.SaveSetting()
  This.UpdateSetting()
 ENDPROC
 
 PROTECTED PROCEDURE SaveSetting
  LOCAL lcFirstPart, lcSecondPart, lnSecondPosition, lcCommand
  lcFirstPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, 1, SETTINGDELIMITERS)))
  DO Case
   CASE INLIST(lcFirstPart, "SET", "ON")
    lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, 2, SETTINGDELIMITERS)))
    lcCommand = lcFirstPart + [("] + lcSecondPart + [")]
    This.SettingType = 0
   CASE INLIST(lcFirstPart, "GOTO", "GO")
    lnSecondPosition = ATC(" IN ", this.SettingCommand)
    IF lnSecondPosition > 0
     lcSecondPart = SUBSTR(this.settingcommand, lnSecondPosition + 4)
    ELSE
     lcSecondPart = ""
    ENDIF
    lcCommand = [RECNO(] + lcSecondPart + [)]
    This.SettingType = 1
   CASE lcFirstPart = "SELECT"
    lcSecondPart = UPPER(ALLTRIM(GETWORDNUM(this.SettingCommand, 2, SETTINGDELIMITERS)))
    lcCommand = [ALIAS()]
    This.SettingType = 2
  ENDCASE
  IF !EMPTY(lcCommand)
   This.PreviousValue = EVALUATE(lcCommand)
  ENDIF
 ENDPROC
 
 PROTECTED PROCEDURE UpdateSetting
  EXECSCRIPT(This.SettingCommand) && Change the setting
 ENDPROC
 
 PROTECTED PROCEDURE RevertSetting
  LOCAL lcCommand, lnStuffPosition, lnStuffLength, lcAliasWas
  DO CASE
   CASE This.SettingType = 0 && SET/ON
    lnStuffPosition = AT(" ", this.Settingcommand, 2) + 1
    lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
   CASE This.SettingType = 1 && GOTO/GO
    lnStuffPosition = AT(" RECORD ", UPPER(this.Settingcommand), 1) + 8
    IF lnStuffPosition < 9
     lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
     lnStuffLength = AT(" ", this.Settingcommand, 2)
     IF lnStuffLength > 0
      lnStuffLength = lnStuffLength - lnStuffPosition + 1
     ELSE
      lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
     ENDIF
    ELSE
     lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
    ENDIF
   CASE This.SettingType = 2 && SELECT
    lnStuffPosition = AT(" ", this.Settingcommand, 1) + 1
    lnStuffLength = LEN(this.settingcommand) - lnStuffPosition + 1
  ENDCASE
  IF !EMPTY(lnStuffPosition)
   lcCommand = STUFF(This.SettingCommand, lnStuffPosition, lnStuffLength, TRANSFORM(this.PreviousValue))
   EXECSCRIPT(lcCommand) && Put things back the way they were before class was instantiated
  ENDIF
 ENDPROC
ENDDEFINE

Tuesday, December 06, 2005 6:11:56 PM (Central Standard Time, UTC-06:00)  #    Comments [2]
Wednesday, December 21, 2005 9:58:20 PM (Central Standard Time, UTC-06:00)
try with SET DATASESSION TO :)
Fabio Lunardon
Friday, December 23, 2005 7:26:58 PM (Central Standard Time, UTC-06:00)
Hi Craig

Pretty neat! Such push/pop classes exist in CodeBook, VFE and MaxFrame. The VMP ones were broken down by type. PushPopSetOnOff, PushPopSetTo. One that I created for VMP was similar to this...

http://foxridgesoftware.com/Blogs/tabid/84/EntryID/2/Default.aspx

Another enhancement I'd like to see in VMP, which you have implemented is to effect the new setting while remembering the current setting.

Mike Yearwood
Name
E-mail
(will show your gravatar icon)
Home page

Comment (Some html is allowed: a@href@title, b, blockquote@cite, em, i, strike, strong, sub, super, u)  

Enter the code shown (prevents robots):


 

Archive

<August 2008>
SunMonTueWedThuFriSat
272829303112
3456789
10111213141516
17181920212223
24252627282930
31123456