REVO2700Vista 64 Patch3@ @altOrigFieldScriptJlocal lMessageBoxIndex, lMessageBoxHistory, lIsFunction, sBackScriptHandlersCommon constant kStackName="Message Box" on returnInField revExecuteMessage end returnInField on commandKeyDown which if which is "P" and the platform is not "MacOS" then revPrevLine if which is "N" and the platform is not "MacOS" then revNextLine if which is "U" then put empty into me set the fixedLineHeight of me to true exit commandKeyDown end if pass commandKeyDown end commandKeyDown on enterInField revExecuteMessage end enterInField on arrowKey which if which is "up" then revPrevLine if which is "down" then revNextLine pass arrowKey end arrowKey on revInitialise put 1 into lMessageBoxIndex if the cREVSingleLineHistory of stack "revPreferences" is empty then put empty & return into lMessageBoxHistory else put the cREVSingleLineHistory of stack "revPreferences" into lMessageBoxHistory end if end revInitialise on revPrevLine subtract 1 from lMessageBoxIndex if lMessageBoxIndex is 0 then put the number of lines in lMessageBoxHistory into lMessageBoxIndex put line lMessageBoxIndex of lMessageBoxHistory into me exit to MetaCard end revPrevLine on revNextLine add 1 to lMessageBoxIndex if lMessageBoxIndex > the number of lines in lMessageBoxHistory then put 1 into lMessageBoxIndex put line lMessageBoxIndex of lMessageBoxHistory into me exit to MetaCard end revNextLine # OK-2007-07-09 : Refactored from revExecuteMessage to try and improve clarity. # Given the line to execute, the whether the intelligence object is the selected object or the mousecontrol does the following: # 1. Sets the value of the script local lIsFunction to true if pLine represents and custom function, to false otherwise # 2. Returns the value the name of the matching custom function if there is one, otherwise false # local "lIsFunction" private function lineIsCustomFunction pLine, pIntelligenceObject put false into lIsFunction repeat for each word tWord in pLine if token 1 of tWord is not among the lines of the functionNames and token 1 of tWord is not "(" and token 2 of tWord is "(" and ")" is in pLine then # Make sure it is not actually a handler, which uses () for some reason, as this is not necessarily a function. # MJVH 18/09/2006 local tHandlers switch pIntelligenceObject case "selectedObject" put revGetHandlerList(the long id of the selobj) into tHandlers break case "mouseControl" put revGetHandlerList(the long id of the mousecontrol) into tHandlers break end switch if token 1 of tWord is among the lines of tHandlers then next repeat end if # OK-2007-12-19 : Bug 5553. If the first token of the word is "url" then # Don't treat it as a function. This is to make sure things like launch url("..") and put url("") work. if token 1 of tWord is "url" then next repeat end if # Ok, we are here. Maybe its a backscript handler, we only check revCommon here. if sBackScriptHandlersCommon is not empty then put sBackScriptHandlersCommon into tHandlers else put revGetHandlerList(the long id of button "revCommon" of card 1 of stack "revLibrary") into tHandlers end if if token 1 of tWord is among the lines of tHandlers then next repeat end if put true into lIsFunction local tHandlerName put token 1 of tWord into tHandlerName exit repeat end if end repeat return tHandlerName end lineIsCustomFunction # OK-2007-07-10 : Refactored from revExecuteMessage to try and improve clarity. # Parameters # pHandler : The name of a handler # pObject : Reference to the object whose script to search # Description # Returns true if pHandler is one of the handlers in the script of pObject, *excluding private handlers*. # Private handlers are excluded because the message box uses send and trying to call one of them # will result in an error. private function handlerInObjectScript pHandler, pObject local tHandlerInScript put false into tHandlerInScript if pObject is not empty then local tDoLoop put true into tDoLoop try local tScript put the script of pObject into tScript catch someError put false into tDoLoop put false into tHandlerInScript end try if tDoLoop then repeat for each line tLine in tScript if word 1 of tLine is among the items of "on,function,command" and word 2 of tLine is pHandler then put true into tHandlerInScript exit repeat end if end repeat end if end if return tHandlerInScript end handlerInObjectScript # OK-2007-07-10 : Refactored from revExecuteMessage to try and improve clarity. # Parameters # pHandler : the name of the handler to search for # Description # Returns true if pHandler is either an externalCommand or externalFunction of the current default stack. # This function also checks the front and back scripts and stacksInUse. private function handlerIsExternal pHandler local tExternal put false into tExternal if pHandler is among the lines of the externalCommands of this stack or pHandler is among the lines of the externalFunctions of this stack then put true into tExternal end if if pHandler is among the lines of the externalCommands of stack (the mainStack of this stack) or pHandler is among the lines of the externalFunctions of stack (the mainStack of this stack) then put true into tExternal end if repeat for each line tLine in the frontScripts if word 1 of tLine is "stack" then if pHandler is among the lines of the externalCommands of tLine or pHandler is among the lines of the externalFunctions of tLine then put true into tExternal end if end if end repeat repeat for each line tLine in the backScripts if word 1 of tLine is "stack" then if pHandler is among the lines of the externalCommands of tLine or pHandler is among the lines of the externalFunctions of tLine then put true into tExternal end if end if end repeat repeat for each line tStack in the stacksInUse if pHandler is among the lines of the externalCommands of stack tStack or pHandler is among the lines of the externalFunctions of stack tStack then put true into tExternal end if end repeat if pHandler is among the lines of the externalCommands of stack "home" or pHandler is among the lines of the externalFunctions of stack "home" then put true into tExternal end if return tExternal end handlerIsExternal private command log pMessage put pMessage & return after msg end log # OK-2007-07-10 : Refactored from revExecute message to try and improve clarity. # Parameters # # Description # Returns all the library scripts, separated by return. In the order, frontscripts, backscripts, stacks in use. private function listAllLibraryScripts local tScripts # OK - No idea why this is here but keeping it for now. local tWorkAround repeat for each line tObject in the frontScripts try put the script of tObject & return after tScripts catch pError put empty into tWorkAround end try end repeat repeat for each line tObject in the backscripts try put the script of tObject & return after tScripts catch pError put empty into tWorkAround end try end repeat repeat for each line tStack in the stacksInUse try put the script of tStack & return after tScripts catch pError put empty into tWorkAround end try end repeat return tScripts end listAllLibraryScripts on revExecuteMessage global gREVHandlerNames do "global" && the globalNames local tMessageLine put the text of field "Message Field" into tMessageLine if tMessageLine is empty then exit revExecuteMessage end if --set which object the Message Box Intelligence should operate on local tIntelligenceObject if the cREVMsgIntelligenceObject of stack "revPreferences" is "selectedObject" then if (the selobj) is not empty then put "selectedObject" into tIntelligenceObject end if else if (the mouseControl) is not empty then put "mouseControl" into tIntelligenceObject end if end if try set the defaultStack to the cREVActiveStack of this stack catch someError -- KM fix 4118 -- stack doesn't exist for some reason, reset revSetActiveStacks set the defaultStack to the cREVActiveStack of this stack end try --do tests on property validity local tIsValidProperty put true into tIsValidProperty local tTestPropertyValidity put empty into tTestPropertyValidity try do "put the" && word 1 of tMessageLine && "of the" && tIntelligenceObject && "into tTestPropertyValidity" catch tErrorNumber put false into tIsValidProperty end try # Check the line represents a custom function (tHandlerName will be empty otherwise) local tHandlerName put lineIsCustomFunction(tMessageLine, tIntelligenceObject) into tHandlerName --check if handler/function is in the script of the intelligence object if tHandlerName is empty then if word 1 of tMessageLine is among the items of "put,get,answer" then put token 1 of word 2 of tMessageLine into tHandlerName else put token 1 of tMessageLine into tHandlerName end if -- Check if the handler is in the script of the "intelligence object" local tHandlerInScript put handlerInObjectScript(tHandlerName, tIntelligenceObject) into tHandlerInScript -- Check if handler is one of the external commands / functions of the current stack. local tExternal put handlerIsExternal(tHandlerName) into tExternal local tAllLibraryScripts put listAllLibraryScripts() into tAllLibraryScripts local tWorkaround try local tCardStackScripts put the script of this card & return & the script of this stack into tCardStackScripts catch tJunk put empty into tWorkAround -- engine bug with error reporting end try local tHandlerInCardOrStackScript put false into tHandlerInCardorStackScript repeat for each line tLine in tCardStackScripts repeat for each line tHandlerLine in tHandlerName if word 1 of tLine is among the items of "on,function,command" and word 2 of tLine is tHandlerLine then put true into tHandlerInCardorStackScript exit repeat end if end repeat end repeat local tHandlerInLibraryScript put false into tHandlerInLibraryScript repeat for each line tLine in tAllLibraryScripts if word 1 of tLine is among the items of "on,function,command" and word 2 of tLine is tHandlerName then put true into tHandlerInLibraryScript exit repeat end if end repeat local tValue put empty into tValue try put value(tMessageLine) into tValue catch tJunk put empty into tWorkAround -- engine bug with error reporting end try local tDoString if the number of words in tMessageLine is 1 then --Message Box "Intelligence" for single word --auto-complete as necesessary switch case tMessageLine is among the lines of the commandNames put tMessageLine into tDoString exit switch case token 1 of tMessageLine is among the lines of the functionNames if token 1 of tMessageLine is tMessageLine then put "put the" && tMessageLine into tDoString else put "put" && tMessageLine into tDoString exit switch case tMessageLine is among the items of the globalNames put "put" && tMessageLine into tDoString exit switch case tMessageLine is among the lines of the cREVAllProperties of cd "Global Properties" of stack kStackName put "put the" && tMessageLine into tDoString exit switch case tHandlerInScript case tHandlerInCardorStackScript case lIsFunction case tExternal local tSendMessage put true into tSendMessage exit switch case tValue is a number case tValue is a boolean put "put" && tMessageLine after tDoString exit switch case tIntelligenceObject is not empty switch case tMessageLine is among the lines of the propertyNames and tIsValidProperty case tTestPropertyValidity is not empty case tMessageLine is among lines of the customKeys of tIntelligenceObject --word is in the propertyNames and is a valid property for the mouseControl or selobj --or word is a customproperty put "put the" && tMessageLine && "of the" && tIntelligenceObject into tDoString exit switch default put true into tSendMessage exit switch end switch exit switch default put true into tSendMessage exit switch end switch else if the number of words in tMessageLine > 1 then --message box "intelligence" for multiple word messages local tFirstWord put word 1 of tMessageLine into tFirstWord switch case tHandlerInScript case tHandlerInCardorStackScript case lIsFunction case tExternal put true into tSendMessage exit switch case tFirstWord is among the lines of the commandNames put tMessageLine into tDoString exit switch case tFirstWord is among the lines of the cREVAllProperties of cd "Global Properties" of stack kStackName put "put the" && tMessageLine into tDoString exit switch case tFirstWord is "the" case tFirstWord is "char" case tFirstWord is "word" case tFirstWord is "token" case tFirstWord is "item" case tFirstWord is "line" case tValue is a boolean put "put" && tMessageLine into tDoString exit switch case token 1 of tFirstWord is among the lines of the functionNames if token 1 of tFirstWord is tFirstWord then put "put the" && tMessageLine into tDoString else put "put" && tMessageLine into tDoString exit switch case tValue is a number --put "put value(" & tMessageLine & ")" into tDoString put "put" && tMessageLine after tDoString exit switch default put true into tSendMessage end switch end if put empty into fld 1 of this cd of stack kStackName if tSendMessage then --send message "intelligence" object or current card of active stack if tHandlerInScript then local tIntelligenceObjectId put the long id of tIntelligenceObject into tIntelligenceObjectID revSendMessage tIntelligenceObjectID else revSendMessage the long id of this cd end if else --do message put tDoString into fld "Message Field" of stack kStackName --show result if there is one --result could be at odds with what is intended if word 1 of tDoString is not "put" then put cr & "if the result is not empty then put the result" after tDoString --if Script Debugger is open then debugdo commands if the cREVDebugMode of stack kStackName then revDebugDoMessage tDoString else revDoMessage tDoString end if if the mode of stack kStackName is not 0 and "edit script of" is not in the text of me then select the text of field "Message Field" of stack kStackName end if local tLineToAddToHistory if tSendMessage then put tMessageLine into tLineToAddToHistory else put line 1 of tDoString into tLineToAddToHistory end if put 1 into lMessageBoxIndex # OK-2007-08-01 : This looks wrong, better to delete the duplicate entry then add the new entry to the bottom -- don't add duplicates to history -- if tLineToAddToHistory is not the last line of lMessageBoxHistory then -- put cr & tLineToAddToHistory after lMessageBoxHistory -- end if local tDuplicateLineNumber put lineOffset(tLineToAddToHistory, lMessageBoxHistory) into tDuplicateLineNumber if tDuplicateLineNumber <> 0 then delete line tDuplicateLineNumber of lMessageBoxHistory end if put tLineToAddToHistory & return after lMessageBoxHistory if the number of lines in lMessageBoxHistory > 200 then delete line 1 of lMessageBoxHistory end if set the cREVSingleLineHistory of stack "revPreferences" to lMessageBoxHistory end revExecuteMessage # MJVH 18/09/2006 little function to return all handlers of a script. --function revGetHandlerList pObject -- local tObjectScript, tResult -- put the script of pObject into tObjectScript -- filter tObjectScript with "on *" -- repeat for each line tLine in tObjectScript -- put word 2 of tLine & return after tResult -- end repeat -- delete the last char of tResult -- return tResult --end revGetHandlerList # OK-2007-07-09 : Modified to include commands. Does not return private handlers because this would just result in an error. function revGetHandlerList pObject local tObjectScript put the script of pObject into tObjectScript local tResult repeat for each line tLine in tObjectScript if matchText(tLine, "(^on )|(^command )|(^function )") then put word 2 of tLine & return after tResult end if end repeat delete the last char of tResult return tResult end revGetHandlerList constant kExternalErrorCode = 634 on revSendMessage pObject do "global" && the globalNames --send message to intelligence object or card local tHandler put me into tHandler if word 1 of tHandler is among the items of "put,get" then delete word 1 of tHandler try if lIsFunction then if word 1 of tHandler is "answer" then answer value(word 2 to -1 of tHandler,pObject) else put value(tHandler,pObject) end if else local tMessage put the text of me into tMessage #answer tMessage # OK-2007-06-29: Bug 4904. It appears that when sending tMesssage to pObject, if tMessage begins with # whitespace chars, then the message is still sent, but with incomplete parameters. The fix is just a hack # that removes these. local tFirstWordOffset put offset(word 1 of tMessage, tMessage) into tFirstWordOffset if tFirstWordOffset > 1 then delete char 1 to (tFirstWordOffset - 1) of tMessage end if send tMessage to pObject end if catch tError --answer "Error thrown: " & tError if item 1 of tError is a number and item 1 of tError >= 0 then # OK-2008-03-14 : Bug 6060 if item 1 of tError is kExternalErrorCode then put "External execution error:" & return & "Error description: " & item 4 to -1 of line 1 of tError else if item 2 of tError is 0 then local tLineNo put item 1 of line 1 of tError into tLineNo put "Script compile error:" & cr & "Error description:" && line tLineNo of the cErrorsList of cd 1 of stack "revErrorDisplay" else put "Message execution error:" & cr & "Error description:" && line (item 1 of line 1 of tError) of the cErrorsList of cd 1 of stack "revErrorDisplay" end if else--custom error thrown put tError end if end try end revSendMessage altRevDebugPatch--> INSERTED BY CHIPP WALTERS filter tGlobalsRaw without "*(x86)" --> FINISH INSERT sort lines of tGlobalsRaw ascendingaltTextToReplacedo "global" && the globalNamesaltOrigStackScriptK0local lFirstFocus # OK-2007-06-28 local lMessageBoxIndex, lNoMessages on closeCard local tPropName put "cREVMsgTabRect" & the short name of this cd into tPropName if the num of words in tPropName is 2 then put word 1 of tPropName & word 2 of tPropName into tPropName set the tPropName of stack "revPreferences" to the width of this stack,the height of this stack end closeCard on closeStack set the cREVMsgTopLeft of stack "revPreferences" to the topLeft of this stack end closeStack on preOpenStack lock screen revMessageBoxUpdateMode local tLeft put item 1 of the cREVMsgTopLeft of stack "revPreferences" into tLeft local tTop put item 2 of the cREVMsgTopLeft of stack "revPreferences" into tTop local tWindowBoundingRect put the windowBoundingRect into tWindowBoundingRect local tMaxX put item 3 of tWindowBoundingRect into tMaxX local tMaxY put item 4 of tWindowBoundingRect into tMaxY if the height of this stack > tMaxY then set the height of this stack to tMaxY if the width of this stack > tMaxX then set the width of this stack to tMaxX set the topLeft of this stack to tLeft,tTop local tRight put the right of this stack into tRight local tBottom put the bottom of this stack into tBottom revInternal__ConstrainStack "Message Box" # OK-2007-09-12 : Bug 5366 and Bug 5598 if the cREVSingleLineHistory of stack "revPreferences" is empty then put empty into field "Message Field" of card "Single Line" of me else put line -1 of the cREVSingleLineHistory of stack "revPreferences" into field "Message Field" of card "Single Line" of me end if if the cREVMultipleLineHistory of stack "revPreferences" is empty then put empty into field "Message Field" of card "Multiple Lines" of me else # OK-2008-03-05 : Bug 6018 # The history is delimited "|" chars, not returns. -- put line -1 of the cREVMultipleLineHistory of stack "revPreferences" into field "Message Field" of card "Multiple Lines" of me local tPreviousDelimiter put the itemDelimiter into tPreviousDelimiter set the itemDelimiter to "|" put item -1 of the cREVMultipleLineHistory of stack "revPreferences" into field "Message Field" of card "Multiple Lines" of me set itemDelimiter to tPreviousDelimiter end if send "revInitialise" to field "Message Field" of card "Single Line" send "revInitialise" to field "Message Field" of card "Multiple Lines" if not the cUserOpen of this stack then --Message Box opening to show what has been "put" go cd "Single Line" set the title of this stack to "Message Box (Single Line)" set the hilitedButtonName of group "button tabs" of cd 1 to "Single Line" end if set the cUserOpen of this stack to false # OK-2007-08-10 : Bug 5156. Set the status to the saved value in preferences stack. # Using the expanded state as the default value. if the cREVMessageBoxControlStatus of stack "revPreferences" is "condensed" then controlsCondense else controlsExpand end if unlock screen end preOpenStack on moveStack set the cREVMsgTopLeft of stack "revPreferences" to the topLeft of this stack end moveStack on commandKeyDown pKey local tCommaKeyWhenShiftDown if the platform is "MacOS" then put comma into tCommaKeyWhenShiftDown else put "<" into tCommaKeyWhenShiftDown end if if pKey is tCommaKeyWhenShiftDown and shiftKey() is down then if the num of this cd is not 1 then click at the loc of btn (the short name of card (the num of this card - 1)) else click at the loc of btn "backScripts" end if else if pKey is "," then if the num of this cd is not 7 then click at the loc of btn (the short name of card (the num of this card + 1)) else click at the loc of btn "Single Line" end if end if end if pass commandKeyDown end commandKeyDown on preOpenCard global msg lock screen local tCard put the short name of this card into tCard if tCard is among the items of "Single Line,Multiple Lines" then --message tabs --set defaultStack/traceStack and lock attributes --set object to use for intelligence if the cREVMsgIntelligenceObject of stack "revPreferences" is not empty then set the hilitedButtonName of grp "Intelligence Object" to the cREVMsgIntelligenceObject of stack "revPreferences" else set the hilitedButtonName of grp "Intelligence Object" to "selectedObject" set the cREVDebugMode of this stack to the cREVDebugMode of this stack --remember "results" fld between tabs put msg into fld 1 focus fld "Message Field" select the text of fld "Message Field" else --non message card put "/REVEXCLUDE02" into fld 1 end if put true into lFirstFocus --geometry lock messages local tPropName put "cREVMsgTabRect" & the short name of this cd into tPropName if the num of words in tPropName is 2 then put word 1 of tPropName & word 2 of tPropName into tPropName set the rect of this stack to item 1 to 2 of the rect of this stack,(item 1 of the rect of this stack + item 1 of the tPropName of stack "revPreferences"),(item 2 of the rect of this stack + item 2 of the tPropName of stack "revPreferences") # OK-2007-08-10 : Bug 5156, no longer required. # send "mouseUp" to btn "disclosure triangle" revUpdateGeometry if the short name of this cd is "multiple lines" then set the cREVMinHeight of this cd of this stack to 51 + the height of fld "results" set the minHeight of this stack to the cREVMinHeight of this cd set the minWidth of this stack to the cREVMinWidth of this cd if the short name of this cd is in "Single Line, Multiple Lines" then --geometry set the right of btn "revLocktoStack" to (the width of this stack - 61) end if unlock messages --Need to set hilitedLines after setting geometry --because setting the rect of a list fld loses its selection. if the short name of this cd is "Global Variables" then if the cREVHilitedVariable of fld "Type" is empty then set the hilitedLines of fld "Type" to 1 else set the hilitedLines of fld "Type" to the cREVHilitedVariable of fld "Type" --update contents fld according to hilitedLine send "revDisplayGlobals" to fld "Type" end if if the short name of this cd is "Global Properties" then if the cREVHilitedProperty of fld "Type" is empty then set the hilitedLines of fld "Type" to 1 else set the hilitedLines of fld "Type" to the cREVHilitedProperty of fld "Type" --update contents fld according to hilitedLine send "revDisplayProperties" to fld "Type" end if # OK-2007-08-01 : Bug 5040 if the short name of this card is "Single Line" then revUpdateActiveStack the cREVActiveStack of me, the cREVActiveStack of me end if pass preOpenCard unlock screen end preOpenCard setprop cREVDebugMode pValue if the short name of this cd is among the items of "Single Line,Multiple Lines" then if pValue is true then --link message box to trace stack local tTraceStack put the short name of the traceStack into tTraceStack set the cREVActiveStack of this stack to tTraceStack disable btn "Open Stacks" set the label of btn "Open Stacks" to tTraceStack --hide lock btn disable btn "revLocktoStack" set the hiliteBorder of btn "revLocktoStack" to true unhilite btn "revLocktoStack" set the toolTip of btn "revLocktoStack" to empty set the showIcon of btn "revLocktoStack" to false else --unlink message box from traceStack if the cREVLockedToStack of this stack and there is a stack (the cREVLinkedStack of this stack) then --reset to stack it was previously linked to set the cREVActiveStack of this stack to the cREVLinkedStack of this stack enable btn "Open Stacks" set the label of btn "Open Stacks" to the cREVLinkedStack of this stack --lock btn enable btn "revLocktoStack" set the hiliteBorder of btn "revLocktoStack" to false hilite btn "revLockToStack" set the showIcon of btn "revLocktoStack" to true set the toolTip of btn "revLocktoStack" to "Unlock defaultStack" else --use topmost stack, don't link local tTopStack put the short name of the topStack into tTopStack set the cREVActiveStack of this stack to tTopStack set the cREVLockedToStack of this stack to false set the cREVLinkedStack of this stack to empty enable btn "Open Stacks" set the label of btn "Open Stacks" to tTopStack --lock btn enable btn "revLocktoStack" set the hiliteBorder of btn "revLocktoStack" to false unhilite btn "revLocktoStack" set the showIcon of btn "revLocktoStack" to true set the toolTip of btn "revLocktoStack" to "Lock defaultStack" end if end if revSetLabelSize end if pass cREVDebugMode end cREVDebugMode on revSetLabelSize local tRight put min(the left of button "Open Stacks" + the formattedWidth of button "Open Stacks", the left of button "revLockToStack") into tRight set the rect of button "Open Stacks" to the topLeft of button "Open Stacks", tRight, the bottom of button "Open Stacks" if the short name of this card is "Single Line" then revUpdateActiveStack the cREVActiveStack of me, the cREVActiveStack of me end if end revSetLabelSize on revPrevLine --go to the previous message local tCard put the short name of this cd into tCard subtract 1 from lMessageBoxIndex[tCard] if lMessageBoxIndex[tCard] < 0 then put lNoMessages[tCard] into lMessageBoxIndex[tCard] end if local tMessageReference put lMessageBoxIndex[tCard] into tMessageReference put the cREVMessageBoxHistory[tMessageReference] of field "Message Field" into field "Message Field" exit to top end revPrevLine on revNextLine --go to the next message local tCard put the short name of this cd into tCard add 1 to lMessageBoxIndex[tCard] if lMessageBoxIndex[tCard] > lNoMessages[tCard] then put 0 into lMessageBoxIndex[tCard] end if local tMessageReference put lMessageBoxIndex[tCard] into tMessageReference put the cREVMessageBoxHistory[tMessageReference] of fld "Message Field" into fld "Message Field" exit to top end revNextLine on revDoMessage pDoString do "global" && the globalNames if revCompileTest(pDoString) is false then exit revDoMessage local tJunk put revDummyFunction() into tJunk try do pDoString catch tError if item 1 of tError is a number and item 1 of tError >= 0 then put "Message execution error:" & cr & "Error description:" && revIDELookupError("execution", item 1 of line 1 of tError) else--custom error thrown put tError end if end try end revDoMessage function revDummyFunction return empty end revDummyFunction # OK-2008-06-24 : Fix for problem where message box does not always go into debug mode when it should # Description # Updates the message box mode to reflect whether or not we are debugging something. command revMessageBoxUpdateMode if the traceStack is not empty then set the cREVDebugMode of this stack to true else set the cREVDebugMode of this stack to false end if end revMessageBoxUpdateMode --on revDebugDoMessage pDoString -- do "global" && the globalNames -- get the menuHistory of btn "Execution Contexts" of stack "revVariableWatcher" -- if it is empty then get the cContexts of btn "Execution Contexts" of stack "revVariableWatcher" -- set the debugContext to line it of the cContexts of btn "Execution Contexts" of stack "revVariableWatcher" -- if revCompileTest(pDoString) is false then exit revDebugDoMessage -- local tJunk -- put revDummyFunction() into tJunk -- try -- debugdo pDoString -- catch tError -- if item 1 of tError is a number and item 1 of tError >= 0 then -- put "Message execution error:" & cr & "Error description:" && line (item 1 of line 1 of tError) of the cErrorsList of cd 1 of stack "revErrorDisplay" -- else--custom error thrown -- put tError -- end if -- end try --end revDebugDoMessage # OK-2008-05-06 : Modified for new script editor. command revDebugDoMessage pMessage if revCompileTest(pMessage) is false then exit revDebugDoMessage end if local tContext put revDebuggerGetContext() into tContext local tResult, tError revDebuggerDo pMessage, tContext get the result put line 1 of it into tResult put line 2 to -1 of it into tError if tError is not empty then if item 1 of tError is a number and item 1 of tError >= 0 then put "Message execution error:" & return & "Error description:" && revIDELookupError("execution", (item 1 of line 1 of tError)) else put tError end if end if end revDebugDoMessage function revCompileTest pScript global gREVDevelopment local tCompileTest put "on mouseUp" & cr & pScript & cr & "end mouseUp" into tCompileTest local tResult set the script of btn "Compile Test" of cd 1 of stack "Message Box" to tCompileTest put the result into tResult set the script of btn "Compile Test" of cd 1 of stack "Message Box" to empty local tDudErrors put true into tDudErrors repeat for each line l in tResult if item 2 of l is not 0 then put false into tDudErrors end repeat if not tDudErrors then #put "Script compile error:" & cr & "Error description:" && line (item 1 of tResult) of the cScriptErrors of cd 1 of stack "revErrorDisplay" put "Script compile error:" & cr & "Error description:" && revIDELookupError("compilation", item 1 of tResult) return false else return true end revCompileTest # OK-2007-06-28: Bug 5040. # Parameters # pOldName : The previous name of the active stack # pNewName : The new name of the active stack # Description # Sent from revFrontScript when the active stack is changed. Updates the message box appropriately on revUpdateActiveStack pOldName, pNewName if not the cREVLockedToStack of stack "Message Box" then # OK-2007-09-12 : Just noticed that this can throw an error. The handler is in revFrontscript, which apparently is not # a frontscript all the time... -- revSetActiveStacks send "revSetActiveStacks" to button "revFrontScript" of card 1 of stack "revLibrary" exit revUpdateActiveStack end if if the cREVLinkedStack of me is pOldName then local tDefaultStack put the defaultStack into tDefaultStack set the defaultStack to "Message Box" set the cREVLinkedStack of me to pNewName set the cREVActiveStack of me to pNewName if the short name of this card of me is among the items of "Single Line,Multiple Lines" then set the label of button "Open Stacks" of this card of me to pNewName revSetLabelSize end if set the defaultStack to tDefaultStack end if end revUpdateActiveStack # OK-2007-08-10 : Refactored from mouseUp handler of button "Disclosure Triangle" # Expands the message box controls, i.e. performs the expansion action of the "Disclosure Triangle" button command controlsExpand lock screen set the top of group "button tabs" to -5 set the cREVExpanded of this stack to true switch the short name of this cd case "single line" set the top of field "message field" to 23 set the cREVMinHeight of this card to 72 set the minHeight of this stack to 72 if the height of this stack < 72 then set the rect of this stack to item 1 to 3 of the rect of this stack, the top of this stack + 72 end if set the top of group "single line" to -9 set the top of field "results" to the bottom of image "drag bar" +1 set the bottom of button "revLocktoStack" to 19 revUpdateGeometry break case "multiple lines" local tRect put the rect of field "message field" into tRect set the rect of field "message field" to item 1 of tRect,23,item 3 of tRect,the top of button "drag bar" set the cREVMinHeight of field "message field" to 21 set the top of group "intelligence object" to -1 set the top of button "open stacks" to 0 set the bottom of button "revLocktoStack" to 19 break case "Global Properties" set the top of group "Global Properties Controls" to 23 set the top of field "Values Range" to 29 revUpdateGeometry break case "Global Variables" set the top of group "Global Properties Controls" to 23 revUpdateGeometry break case "pendingMessages" set the top of field "display" to 27 revUpdateGeometry break case "frontScripts" set the top of field "display" to 27 revUpdateGeometry break case "backScripts" set the top of field "display" to 27 revUpdateGeometry break case "stacksInUse" set the top of field "stacksInUse" to 27 revUpdateGeometry break end switch # OK-2007-08-10 : Bug 5156 set the cREVMessageBoxControlStatus of stack "revPreferences" to "expanded" set the hilite of button "Disclosure Triangle" to true end controlsExpand # Condenses the message box controls, i.e. performs the condension action of the "Disclosure Triangle" button command controlsCondense lock screen set the top of group "button tabs" to -29 set the cREVExpanded of this stack to false switch the short name of this card case "single line" set the top of field "message field" to 0 set the cREVMinHeight of this card to 48 set the minHeight of this stack to 48 set the top of group "single line" to -33 set the top of field "results" to the bottom of image "drag bar" set the bottom of button "revLocktoStack" to -100 revUpdateGeometry break case "multiple lines" local tRect put the rect of field "message field" into tRect set the rect of field "message field" to item 1 of tRect,1,item 3 of tRect,the top of button "drag bar" set the cREVMinHeight of field "message field" to 45 set the top of group "intelligence object" to -26 set the top of button "open stacks" to -20 set the bottom of button "revLocktoStack" to -100 break case "Global Properties" set the top of group "Global Properties Controls" to -1 set the top of field "Values Range" to 5 revUpdateGeometry break case "Global Variables" set the top of group "Global Properties Controls" to -1 revUpdateGeometry break case "pendingMessages" set the top of field "display" to 4 revUpdateGeometry break case "frontScripts" set the top of field "display" to 4 revUpdateGeometry break case "backScripts" set the top of field "display" to 4 revUpdateGeometry break case "stacksInUse" set the top of field "stacksInUse" to 4 revUpdateGeometry break end switch unlock screen # OK-2007-08-10 : Bug 5156 set the cREVMessageBoxControlStatus of stack "revPreferences" to "condensed" set the hilite of button "Disclosure Triangle" to false end controlsCondense altOrigDebugScript# This constant specifies that the debugger should use the cREVGeneral # custom property set to store its metadata. constant kMetadataType = "general" local sLastObject local sLastHandler local sLastLine ################################################################################ # # Debugger Library Interface # ################################################################################ # Description # Initializes the debugger, should be called on IDE startup or when script debug mode is turned on. command revDebuggerInitialize # When the debugger is first initialized, the breakpoints property should be empty as other # IDE stacks should not be setting it. Unfortunately if there are no breakpoints set, traceError messages # are not sent by the engine, so we have to set a dummy breakpoint here to prevent this problem. if debuggerEnabled() then set the breakpoints to the long id of group 1 of stack "revLibrary",500 else set the breakpoints to empty end if end revDebuggerInitialize # Returns # Whether or not the debugger is enabled. This is currently defined as whether or not the cREVScriptDebugMode # of stack "revPreferences" is true. function revDebuggerEnabled return debuggerEnabled() end revDebuggerEnabled # Description # Enables the debugger, should be called when the user switches script debug mode on. command revDebuggerEnable # When the debugger is enabled we need to go through all the open stacks and # activate their breakpoints if appropriate. local tOpenStacks put the openStacks into tOpenStacks repeat for each line tStack in tOpenStacks if not debuggerStackAllowed(the long id of stack tStack) then next repeat end if revDebuggerActivateBreakpoints the long id of stack tStack end repeat set the cREVScriptDebugMode of stack "revPreferences" to true # OK-2008-08-07 : 6875 - The debugger must be re-initialized when script debug node is switched on. revDebuggerInitialize end revDebuggerEnable local sContext # Description # Disables the debugger, should be called when the user switches script debug mode off. command revDebuggerDisable set the breakpoints to empty set the cREVScriptDebugMode of stack "revPreferences" to false put empty into sContext end revDebuggerDisable # Returns # The current debug context if there is one, empty otherwise. The context returned by this function # is persistent, in that if we are debugging, there is always a debug context. Unless the debug context # is set by using revDebuggerSetContext, it will be the context of the next line to execute in the debugger. function revDebuggerGetContext # Check that we are definitely still debugging- the user may have manually turned off the debugger. if the traceStack is empty or not revDebuggerEnabled() then return empty end if # If we are debugging, but there is no context set, we use the next line to be executed, # which is the first line of revDebuggerContexts (hopefully). local tContext if sContext is empty then put line 1 of revDebuggerContexts() into tContext else put sContext into tContext end if return tContext end revDebuggerGetContext # Parameters # pContext : a debug context in the format returned by revDebuggerContexts. Note this includes a number as the first item. # Description # Sets the debugger context to pContext. This value will only remain while the debugger remains on its current line # when the line changes (e.g. because the user has pressed "Step over") the context will be reset to the current one. command revDebuggerSetContext pContext put pContext into sContext end revDebuggerSetContext # Returns # A list of execution contexts # Description # This function returns a filtered list of execution contexts with IDE contexts removed. # The returned list is reversed so that it takes the order of a call stack. Whether the debugger is active # or not is defined as whether the revDebuggerContexts is empty. function revDebuggerContexts local tContextsRaw, tContexts, tControl, tStack global gREVDevelopment put the executionContexts into tContextsRaw # tLineNumber contains a one-based index that links directly into MCexecutioncontexts in the engine # allowing us to deal with situations when multiple contexts have the same object and line number (recursion). local tLineNumber put 0 into tLineNumber repeat for each line tContext in tContextsRaw add 1 to tLineNumber put item 1 to -3 of tContext into tControl put revTargetStack(the long id of tControl) into tStack # If gREVDevelopment is false then only non IDE stacks can appear in the contexts if not gREVDEvelopment then if debuggerStackAllowed(the long id of stack tStack) then put return & tLineNumber & comma & tContext before tContexts else next repeat end if else # If in development mode, we allow debugging of any stack except the # debugger itself and anything that was called by the debugger, i.e. appears after a debugger # call in the call stack. if tStack is "revDebugger" then # No debugger stack contexts are placed onto the call stack, however we also need to remove # *any* contexts that appear after a trace, traceError or traceBreak (or traceDone although less important). if item -2 of tContext is among the words of "trace traceError traceBreak traceDone" then exit repeat else next repeat end if else put return & tLineNumber & comma & tContext before tContexts end if end if end repeat delete the first char of tContexts return tContexts end revDebuggerContexts # Returns # A list of global variable names # Description # Returns a filtered list of global names. Included for symmetry with other call to get variable names. # The list contains one global name per line. function revDebuggerGlobalNames local tGlobalsRaw, tGlobals put the globals into tGlobalsRaw replace comma with return in tGlobalsRaw global gREVShowStacks if gREVShowStacks is not true then filter tGlobalsRaw without "gREV*" end if sort lines of tGlobalsRaw ascending put tGlobalsRaw into tGlobals return tGlobals end revDebuggerGlobalNames # Parameters # pContext : a debug context in the format returned by revDebuggerContexts (,,, # Returns # A list of local variable names in a given debug context. The list contains three lines, each line is a list of # variable names separated by commas. Line 1 contains the parameter passed to the current handler, line 2 contains # the local variables declared in the current handler up to the current execution point. Line 3 contains the currently # declared script local variables. If pContext is empty, attempts to use the current debugger context. function revDebuggerLocalNames pContext local tLocalsRaw, tLocalsCommand, tLocals, tNames put "return the localNames" into tLocalsCommand local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if set the debugContext to item 1 of tContext debugDo tLocalsCommand put the result into tLocalsRaw set the debugContext to empty -- Line 1 is the parameters passed to the current handler/function -- Line 2 is the locals declared in the current handler/function -- line 3 is the script locals -- For now we just combine and sort. repeat for each line tLine in tLocalsRaw if tLine is not empty then put tLine into tNames replace comma with return in tNames put tNames & return after tLocals end if end repeat delete the last char of tLocals sort lines of tLocals ascending return tLocals end revDebuggerLocalNames # Parameters # pContext : a debug context in the format returned by revDebuggerContexts (,,, # Returns # A list of variable names in the specified context. The return value is in the same format as the variableNames property. If no context is specified # the current debugger context is used. function revDebuggerVariableNames pContext local tCommand put "return the variableNames" into tCommand local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if set the debugContext to item 1 of tContext local tVariablesRaw debugDo tCommand put the result into tVariablesRaw set the debugContext to empty # For now, return with no processing return tVariablesRaw end revDebuggerVariableNames # Parameters # pVariable : the name of a variable, can also be an array element. # pContext : the debug context to get the variable's value at. Must be one of the current revDebuggerContexts. # Returns # The value of the variable (does this differentiate between undefined and empty?). If pContext is not specified, uses sContext function revDebuggerGetValue pVariable, pContext local tValue, tCommand local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if # Put the variable's actual name into tName. If pVariable is in the form [] then # tName will contain just . local tName set the itemDelimiter to "[" put item 1 of pVariable into tName set the itemDelimiter to comma if tName is among the items of the globalNames then put "global " & tName & "; return " & pVariable into tCommand else put "return " & pVariable into tCommand end if set the debugContext to item 1 of tContext debugDo tCommand put the result into tValue set the debugContext to empty return tValue end revDebuggerGetValue # Parameters # pName : the name of an array variable # pContext : the debug context to get the variable's keys at. Must be one of the curent revDebuggerContexts. # Returns # A sorted list of keys for the given variable. If the extents of the array are non-empty then the list is sorted # numerically, otherwise it is sorted alphebetically. If pContext is empty then uses sContext. function revDebuggerGetKeys pName, pContext local tKeys, tCommand, tExtents, tExtentsCommand local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if if pName is among the items of the globalNames then put "global " & pName & "; return the keys of " & pName into tCommand else put "return the keys of " & pName into tCommand end if put "return the extents of " & pName into tExtentsCommand set the debugContext to item 1 of tContext debugDo tCommand put the result into tKeys debugDo tExtentsCommand put the result into tExtents set the debugContext to empty if tExtents is empty then sort tKeys else sort tKeys numeric end if return tKeys end revDebuggerGetKeys # Parameters # pCommand : a chunk of Revolution code to execute # pContext : the debug context to execute in, must be in the form returned by revDebuggerContexts # Description # Executes the specified code in the debug context pContext, # returns the result on line 1 and any error that may have ocurred on line 2. # If pContext is empty, uses sContext. command revDebuggerDo pCommand, pContext local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if local tResult set the debugContext to item 1 of tContext try debugDo pCommand put the result into tResult catch tError return tError end try set the debugContext to empty return tResult & return & tError end revDebuggerDo local sDebugElements, sDebugValue # Parameters # pVariableName : the name of the variable to set # pElementList : a numeric array of keys, or empty if pVariableName is not an array # pNewValue : the new value to set # pContext : the debug context, if empty, uses sContext # Description # Sets the specified value in the specified debug context command revDebuggerSetValue pVariableName, pElementList, @pNewValue, pContext -- if pVariableName is among the items of the globalNames then -- put "global " & the globalNames & return into tStatement -- end if put pElementList into sDebugElements put pNewValue into sDebugValue -- local tStatement -- put "put pNewValue into " & pVariableName after tStatement -- repeat with x = 1 to item 2 of line 1 of extents(pElementList) -- put "[pElementList[" & x & "]]" after tStatement -- end repeat # In order not to interfere with the code being debugged, we change the value by passing a reference # to the variable to be changed back to the debugger. This prevents the creation of any variables in the # current debug context. local tStatement put "revDebuggerSetValueDo " & pVariableName into tStatement local tContext if pContext is empty then put revDebuggerGetContext() into tContext else put pContext into tContext end if local tResult set the debugContext to item 1 of tContext try debugDo tStatement put the result into tResult catch tError return tError end try delete variable sDebugValue delete variable sDebugElements return tResult end revDebuggerSetValue command revDebuggerSetValueDo @pVariable local tStatement put "put sDebugValue into pVariable" into tStatement repeat with x = 1 to item 2 of line 1 of extents(sDebugElements) put "[sDebugElements[" & x & "]]" after tStatement end repeat do tStatement end revDebuggerSetValueDo # Description # Runs the currently debugging script until the next breakpoint command revDebuggerRun set the traceStack to empty set the traceUntil to 65535 set the traceReturn to true revDebuggerSetContext empty end revDebuggerRun # Description # Performs the debugger "stop" function, terminates the script currently being debugged command revDebuggerStop # When executing certain structures, the debugger will continue to loop until the # breakpoints property becomes empty. In order to make sure the debugger always # exits when asked to, we set the breakpoints to empty here and restore them again # once the handler is finished. local tBreakpoints put the breakpoints into tBreakpoints set the breakpoints to empty set the traceStack to empty set the traceUntil to 65535 set the traceAbort to true set the traceReturn to true revDebuggerSetContext empty send "revDebuggerSetBreakpoints tBreakpoints" to me in 0 milliseconds end revDebuggerStop # Parameters # pBreakpoints : the value to set the breakpoints property to. # Description # Sets the breakpoints property to the specified value. Please do not call this command # from outside the debugger. It has to be made public due to how the debugger works in the engine. command revDebuggerSetBreakpoints pBreakpoints set the breakpoints to pBreakpoints end revDebuggerSetBreakpoints # Stores the last trace mode chosen by the user. This is either "Step Over", "Step Into" or "Step Out" local sLastTraceMode # Parameters # pObject : reference to the object to perform the step into on. # Description # Performs the step into debugger action. If the next line to execute cannot be stepped into, # e.g. because its an engine command, does the same as step over. command revDebuggerStepInto pObject put "Step Into" into sLastTraceMode set the traceStack to revTargetStack(pObject) set the traceUntil to 65535 set the traceReturn to true revDebuggerSetContext empty end revDebuggerStepInto # Parameters # pObject : reference to the object to perform the step over on. # Description # Performs the step over debugger action. command revDebuggerStepOver pObject put "Step Over" into sLastTraceMode set the traceStack to revTargetStack(pObject) set the traceReturn to true set the traceUntil to 65535 revDebuggerSetContext empty end revDebuggerStepOver # Parameters # pObject : reference to the object to perform the step out on. # Description # Performs the step out debugger action command revDebuggerStepOut pObject put "Step Out" into sLastTraceMode set the traceStack to revTargetStack(pObject) set the traceReturn to true local tCurrentContexts put revDebuggerContexts() into tCurrentContexts local tNextContext put item 1 of line 1 of tCurrentContexts - 2 into tNextContext set the traceUntil to tNextContext revDebuggerSetContext empty end revDebuggerStepOut # The maximum number of breakpoints that can be active at any time. The debugger library # will not allow more to be activated than this. constant kActiveBreakpointLimit = 100 # Max number of breakpoints that may be added to any object. constant kObjectBreakpointLimit = 100 # Parameters # pObject : reference to the object whose script the breakpoint should be put in # pLine : the line number that the breakpoint should be placed on # Description # Sets a breakpoint on the specified line and object. If the maximum number of # breakpoints has already been reached, does nothing and returns an error string. # Note that the breakpoint must be explicitly activation using the revDebuggerActivateBreakpoint # command before it will actually trigger the debugger to break. # Returns # Empty under normal circumstances. If there are already the maximum number # of breakpoints set then returns an error string. command revDebuggerAddBreakpoint pObject, pLine debuggerAddBreakpoint pObject, pLine, empty end revDebuggerAddBreakpoint # Parameters # pObject : reference to the object whose script the breakpoint should be put in # pLine : the line number that the breakpoint should be placed on # pCondition : a Revolution expression evaluating to true or false. # Description # Sets a conditional breakpoint on the specified line and object. If the maximum number of # breakpoints has already been reached, does nothing and returns an error string. # Note that the breakpoint must be explicitly activation using the revDebuggerActivateBreakpoint # command before it will actually trigger the debugger to break. When creating a conditional # breakpoint, a breakpoint is set on the specified line as normal, but the condition is saved # as metadata along with the breakpoint. When the break is reached, the debugger library # evaluates the condition and only breaks if it evaluates to true. The condition is evaluated in # the context of the line that the breakpoint is on, e.g. all variables will have whatever values # they had at that point of execution. If pCondition is empty a normal breakpoint is set. # Returns # Empty under normal circumstances. If there are already the maximum number # of breakpoints set then returns an error string. command revDebuggerAddConditionalBreakpoint pObject, pLine, pCondition debuggerAddBreakpoint pObject, pLine, pCondition end revDebuggerAddConditionalBreakpoint # Parameters # pObject : reference to the object whose script the breakpoint was in # pLine : the line number of the breakpoint to remove # Description # Removes the specified breakpoint if it exists. Note that this also deactivates it. # Returns # Empty under normal circumstances. If the specified breakpoint cannot be found, # returns an error string but does not throw an error. The reason for this is that # breakpoints are stored as stack metadata, which in theory could be changed from # outside this script (although shouldn't). command revDebuggerRemoveBreakpoint pObject, pLine # Deactivate the breakpoint then remove it from the object revDebuggerDeactivateBreakpoint pObject, pLine local tStack put debuggerTargetStack(pObject) into tStack local tBreakpoint put debuggerGetId(pObject) & comma & pLine into tBreakpoint local tObjectBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tObjectBreakpoints local tStates put revMetadataGet(tStack, kMetadataType, "breakpointstates") into tStates local tConditions put revMetadataGet(tStack, kMetadataType, "breakpointconditions") into tConditions local tLineNumber put debuggerBreakpointOffset(tBreakpoint, tObjectBreakpoints) into tLineNumber if tLineNumber = 0 then return "Breakpoint not found" end if delete line tLineNumber of tObjectBreakpoints delete line tLineNumber of tStates delete line tLineNumber of tConditions revMetadataSet tStack, kMetadataType, "breakpoints", tObjectBreakpoints revMetadataSet tStack, kMetadataType, "breakpointstates", tStates revMetadataSet tStack, kMetadataType, "breakpointconditions", tConditions debuggerCleanBreakpoints tStack end revDebuggerRemoveBreakpoint # Parameters # pOldObject : the currently assigned object of the breakpoint # pOldLine : the currently assigned line of the breakpoint # pNewObject : the new object to move the breakpoint to # pNewLine : the new line to move the breakpoint to # Description # Moves the specified breakpoint to the specified location. This is provided as # a convenience and efficiency helper to the script editor. command revDebuggerMoveBreakpoint pOldObject, pOldLine, pNewObject, pNewLine if pOldLine = pNewLine and the long id of pOldObject is the long id of pNewObject then exit revDebuggerMoveBreakpoint end if if pNewLine < 1 then return "invalid line specified: " pNewLine end if # OK-2008-05-01 : Don't enforce this because the script editor will want to move the # breakpoint before applying the script when the user is editing it. # if pNewLine > the number of lines of the script of pNewObject then # return "invalid line specified: " & pNewLine # end if revDebuggerSuspendBreakpoints pOldObject local tStack put debuggerTargetStack(pOldObject) into tStack local tBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tBreakpoints local tBreakpoint put debuggerGetId(pOldObject) & comma & pOldLine into tBreakpoint local tLineNumber put debuggerBreakpointOffset(tBreakpoint, tBreakpoints) into tLineNumber if tLineNumber = 0 then exit revDebuggerMoveBreakpoint end if local tChanged put false into tChanged put debuggerGetId(pNewObject) & comma & pNewLine into line tLineNumber of tBreakpoints revMetadataSet tStack, kMetadataType, "breakpoints", tBreakpoints revDebuggerRestoreBreakpoints pOldObject end revDebuggerMoveBreakpoint # Description # Removes breakpoints from all open stacks. If gREVDevelopment is true this includes IDE stacks. command revDebuggerClearAllBreakpoints global gREVDevelopment local tMainstacks if not gREVDevelopment then put revFilterStacksList(the mainstacks) into tMainstacks else put the mainstacks into tMainstacks end if local tStacks repeat for each line tMainstack in tMainstacks put the long id of stack tMainstack & return after tStacks repeat for each line tSubstack in the substacks of stack tMainstack put the long id of stack tSubstack of stack tMainstack & return after tStacks end repeat end repeat delete the last char of tStacks repeat for each line tStack in tStacks debuggerClearStackBreakpoints tStack end repeat end revDebuggerClearAllBreakpoints # Parameters # pObject : reference to the object to remove breakpoints from # Description # Removes all breakpoints from the stack that owns pObject, this means all breakpoints set on the # and any of its cards / objects are removed and deactivated. private command debuggerClearStackBreakpoints pObject local tStack put debuggerTargetStack(pObject) into tStack local tStackBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tStackBreakpoints repeat for each line tBreakpoint in tStackBreakpoints # Because the old debugger also used the breakpoints metadata property, we can't assume when # clearing all breakpoints that that values in the metadata will be valid, hence the try. try local tObjectId put debuggerResolveId(item 1 of tBreakpoint, tStack) into tObjectId revDebuggerRemoveBreakpoint tObjectId, item 2 of tBreakpoint end try end repeat end debuggerClearStackBreakpoints # Parameters # pObject : reference to the object to deactivate breakpoints for # Description # Suspends all breakpoints for pObject. This removes them from the breakpoints # property but does not actually mark them as deactivated. Breakpoints are only # suspending temporarily, e.g. next time rev restarts, they will be restored. command revDebuggerSuspendBreakpoints pObject local tBreakpoints put the breakpoints into tBreakpoints local tNewBreakpoints repeat for each line tBreakpoint in tBreakpoints if item 1 to -2 of tBreakpoint is the long id of pObject then next repeat end if put tBreakpoint & return after tNewBreakpoints end repeat delete the last char of tNewBreakpoints set the breakpoints to tNewBreakpoints end revDebuggerSuspendBreakpoints # Parameters # pObject : reference to the object to deactivate breakpoints for # Description # Restores the correct state of all breakpoints for the specified object. # i.e. activates them if their state is "active" command revDebuggerRestoreBreakpoints pObject revDebuggerActivateBreakpoints debuggerTargetStack(pObject), pObject end revDebuggerRestoreBreakpoints # Parameters # pStack : reference to the stack to activate breakpoints for # pObject : reference to an object on the stack # Description # Activates breakpoints stored on pStack. If pObject is empty then all breakpoints # are activated, otherwise only those breakpoints that are in the script of pObject # are activated. command revDebuggerActivateBreakpoints pStack, pObject local tStack if pObject is not empty then put debuggerTargetStack(pObject) into tStack if the long id of tStack is not the long id of pStack then return "invalid object" end if end if local tLineNumber put 1 into tLineNumber local tStackBreakpoints put revMetadataGet(pStack, kMetadataType, "breakpoints") into tStackBreakpoints local tStates put revMetadataGet(pStack, kMetadataType, "breakpointstates") into tStates local tBreakpointsToActivate repeat for each line tBreakpoint in tStackBreakpoints if pObject is empty or item 1 of tBreakpoint is debuggerGetId(pObject) then local tState put line tLineNumber of tStates into tState if tState is "active" then put debuggerResolveId(item 1 of tBreakpoint, pStack) & comma & item 2 of tBreakpoint & return after tBreakpointsToActivate end if end if end repeat delete the last char of tBreakpointsToActivate # If the breakpoints property is allowed to contain duplicates, then the lines with duplicate breakpoints on # will break more than once, i.e. multiple traceBreak messages. We should ensure that this doesn't happen, # as there is no good reason for it and it will just cause annoyance. local tBreakpointsNotActivated repeat for each line tBreakpoint in tBreakpointsToActivate if tBreakpoint is among the lines of the breakpoints then next repeat end if put tBreakpoint & return after tBreakpointsNotActivated end repeat delete the last char of tBreakpointsNotActivated put tBreakpointsNotActivated into tBreakpointsToActivate if the breakpoints is empty then set the breakpoints to tBreakpointsToActivate else set the breakpoints to the breakpoints & return & tBreakpointsToActivate end if end revDebuggerActivateBreakpoints # Parameters # pObject : reference to the object owning the breakpoint # pLine : the line number that the breakpoint is on # Description # Activates the specified breakpoint, if possible. This command might fail if too # many breakpoints have been activated, so check the result. # Returns # Empty if successful, an error string otherwise. command revDebuggerActivateBreakpoint pObject, pLine local tBreakpoint put debuggerGetId(pObject) & comma & pLine into tBreakpoint local tStack put debuggerTargetStack(pObject) into tStack local tObjectBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tObjectBreakpoints local tLineNumber put debuggerBreakpointOffset(tBreakpoint, tObjectBreakpoints) into tLineNumber if tLineNumber = 0 then # This is a bug in the code that called this command return "breakpoint_not_found" end if # Activate the breakpoint local tCurrentBreakpoints put the breakpoints into tCurrentBreakpoints if the number of lines of tCurrentBreakpoints >= kActiveBreakpointLimit then return "Active breakpoint limit reached" end if local tBreakpointString put debuggerResolveId(item 1 of tBreakpoint, tStack) & comma & pLine into tBreakpointString if tCurrentBreakpoints is empty then set the breakpoints to tBreakpointString else if tBreakpointString is not among the lines of tCurrentBreakpoints then set the breakpoints to tCurrentBreakpoints & return & tBreakpointString end if end if # Store the breakpoint's status in the object so it is remembered between restarts etc debuggerUpdateBreakpointStatus tStack, tLineNumber, "active" end revDebuggerActivateBreakpoint # Parameters # pObject : reference to the object owning the breakpoint # pLine : the line number that the breakpiont is on # pCondition : the condition to evaluate # Description # Sets the specified condition on the breakpoint. Set the condition to empty to remove it. command revDebuggerSetBreakpointCondition pObject, pLine, pCondition local tBreakpoint put debuggerGetId(pObject) & comma & pLine into tBreakpoint local tStack put debuggerTargetStack(pObject) into tStack local tObjectBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tObjectBreakpoints local tLineNumber put debuggerBreakpointOffset(tBreakpoint, tObjectBreakpoints) into tLineNumber debuggerUpdateBreakpointCondition tStack, tLineNumber, pCondition end revDebuggerSetBreakpointCondition # Parameters # pObject : reference to the object owning the breakpoint # pLine : the line number that the breakpoint is on # Description # Deactivates the specified breakpoint. command revDebuggerDeactivateBreakpoint pObject, pLine # Ensure that the breakpoint actually exists local tBreakpoint put debuggerGetId(pObject) & comma & pLine into tBreakpoint local tStack put debuggerTargetStack(pObject) into tStack local tObjectBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tObjectBreakpoints local tStackLineNumber put debuggerBreakpointOffset(tBreakpoint, tObjectBreakpoints) into tStackLineNumber if tStackLineNumber = 0 then # This is a bug in the code that called this command. Don't throw errors in the debugger library # if possible though as it could make the IDE unstable. return "breakpoint not found" end if # Deactivate the breakpoint local tCurrentBreakpoints put the breakpoints into tCurrentBreakpoints local tBreakpointString put debuggerResolveId(item 1 of tBreakpoint, tStack) & comma & pLine into tBreakpointString local tLineNumber put debuggerBreakpointOffset(tBreakpointString, tCurrentBreakpoints) into tLineNumber delete line tLineNumber of tCurrentBreakpoints set the breakpoints to tCurrentBreakpoints # Update the breakpoint's status # Store the breakpoint's status in the object so it is remember between restarts etc debuggerUpdateBreakpointStatus tStack, tStackLineNumber, "inactive" end revDebuggerDeactivateBreakpoint # Parameters # pObject : reference to the object to list breakpoints for. # Description # Returns a list of the breakpoints set for pObject. This includes both active # inactive and conditional breakpoints. The breakpoints list is returned in the same # format as the engine "breakpoints" property. function revDebuggerListBreakpoints pObject local tStack put debuggerTargetStack(pObject) into tStack debuggerCleanBreakpoints tStack local tStackBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tStackBreakpoints local tBreakpointsList repeat for each line tBreakpoint in tStackBreakpoints if debuggerGetId(pObject) = item 1 of tBreakpoint then local tBreakpointString put debuggerResolveId(item 1 of tBreakpoint, tStack) & comma & item 2 of tBreakpoint into tBreakpointString put tBreakpointString & return after tBreakpointsList end if end repeat delete the last char of tBreakpointsList return tBreakpointsList end revDebuggerListBreakpoints constant kMaxActiveWatches = 100 # Returns # A list of all active breakpoints function revDebuggerListActiveBreakpoints global gREVDevelopment # With gREVDevelopment we return all breakpoints exactly as they are if gREVDevelopment then return the breakpoints end if # Otherwise we filter out IDE stacks from the breakpoints list. local tBreakpoints put the breakpoints into tBreakpoints local tFilteredBreakpoints repeat for each line tBreakpoint in tBreakpoints local tObject put item 1 to -2 of tBreakpoint into tObject local tStack put revTargetStack(revRuggedId(tObject)) into tStack if revIDEStack(the effective filename of stack tStack) then next repeat end if put tBreakpoint & return after tFilteredBreakpoints end repeat delete the last char of tFilteredBreakpoints return tFilteredBreakpoints end revDebuggerListActiveBreakpoints # Returns # A list of all active watches function revDebuggerListActiveWatches return the watchedVariables end revDebuggerListActiveWatches # Parameters # pObject : reference to the object whose script the watch should be in # pHandler : the name of the handler that the watch should be placed in # pVariable : the name of the variable to watch # pCondition : a Revolution expression to evaluate on hitting the watch. Pass empty for no condition. # Description # Registers a watch with the specified parameters. Does not activate the watch. command revDebuggerAddWatch pObject, pHandler, pVariable, pCondition local tStack put debuggerTargetStack(pObject) into tStack local tWatches put revMetadataGet(tStack, kMetadataType, "watches") into tWatches if the number of lines of tWatches >= kMaxActiveWatches then # Return an error here as the other option, removal of other watches # to make room could potentially confuse the user. return "Maximum number of watches reached" end if local tWatch put debuggerGetId(pObject) & comma & pHandler & comma & pVariable & comma & pCondition into tWatch if tWatches is empty then put tWatch into tWatches else put tWatches & return & tWatch into tWatches end if revMetadataSet tStack, kMetadataType, "watches", tWatches # New watches are initially inactive. local tStates put revMetadataGet(tStack, kMetadataType, "watchstates") into tStates put "inactive" into line (the number of lines of tWatches) of tStates revMetadataSet tStack, kMetadataType, "watchstates", tStates debuggerCleanWatches tStack end revDebuggerAddWatch # Parameters # pObject : reference to the object owning the watch # pHandler : the name of the handler owning the watch # pVariable : the name of the varaiable being watched # Description # Removes the specified watch, deactivating it first. command revDebuggerRemoveWatch pObject, pHandler, pVariable # Deactivate the watch then remove it from the object revDebuggerDeactivateWatch pObject, pHandler, pVariable local tStack put debuggerTargetStack(pObject) into tStack local tWatch put debuggerGetId(pObject) & comma & pHandler & comma & pVariable into tWatch local tStackWatches put revMetadataGet(tStack, kMetadataType, "watches") into tStackWatches local tStates put revMetadataGet(tStack, kMetadataType, "watchstates") into tStates local tLineNumber put debuggerWatchOffset(tWatch, tStackWatches) into tLineNumber if tLineNumber = 0 then return "Watch not found" end if delete line tLineNumber of tStackWatches delete line tLineNumber of tStates revMetadataSet tStack, kMetadataType, "watches", tStackWatches revMetadataSet tStack, kMetadataType, "watchstates", tStates debuggerCleanWatches tStack end revDebuggerRemoveWatch # Parameters # pObject : reference to the object owning the watch # pHandler : the name of the handler owning the watch # pVariable : the name of the varaiable being watched # Description # Activates the specified watch. I.e by putting it into the watchedVariables command revDebuggerActivateWatch pObject, pHandler, pVariable local tWatch put debuggerGetId(pObject) & comma & pHandler & comma & pVariable into tWatch local tStack put debuggerTargetStack(pObject) into tStack local tStackWatches put revMetadataGet(tStack, kMetadataType, "watches") into tStackWatches local tLineNumber put debuggerWatchOffset(tWatch, tStackWatches) into tLineNumber if tLineNumber = 0 then # This is a bug in the code that called this command return "watch_not_found" end if local tCondition put item 4 to -1 of line tLineNumber of tStackWatches into tCondition # Activate the watch local tCurrentWatches put the watchedVariables into tCurrentWatches if the number of lines of tCurrentWatches >= kMaxActiveWatches then return "Active watch limit reached" end if local tWatchString put debuggerResolveId(item 1 of tWatch, tStack) & comma & pHandler & comma & pVariable & comma & tCondition into tWatchString if tCurrentWatches is empty then set the watchedVariables to tWatchString else if tWatchString is not among the lines of tCurrentWatches then set the watchedVariables to tCurrentWatches & return & tWatchString end if end if # Store the breakpoint's status in the object so it is remembered between restarts etc debuggerUpdateWatchStatus tStack, tLineNumber, "active" end revDebuggerActivateWatch # Parameters # pObject : reference to the object owning the watch # pHandler : the name of the handler owning the watch # pVariable : the name of the varaiable being watched # Description # Deactivates the specified watch, by removing it from the watchedVariables. command revDebuggerDeactivateWatch pObject, pHandler, pVariable local tWatch put debuggerGetId(pObject) & comma & pHandler & comma & pVariable into tWatch local tStack put debuggerTargetStack(pObject) into tStack local tStackWatches put revMetadataGet(tStack, kMetadataType, "watches") into tStackWatches local tStackLineNumber put debuggerWatchOffset(tWatch, tStackWatches) into tStackLineNumber if tStackLineNumber = 0 then # This is a bug in the code that called this command. Don't throw errors in the debugger library # if possible though as it could make the IDE unstable. return "Watch not found" end if # Deactivate the watch local tCurrentWatches put the watchedVariables into tCurrentWatches local tCondition put item 4 to -1 of line tStackLineNumber of tStackWatches into tCondition local tWatchString if tCondition is empty then put debuggerResolveId(item 1 of tWatch, tStack) & comma & pHandler & comma & pVariable into tWatchString else put debuggerResolveId(item 1 of tWatch, tStack) & comma & pHandler & comma & pVariable & comma & tCondition into tWatchString end if local tLineNumber put debuggerWatchOffset(tWatchString, tCurrentWatches) into tLineNumber delete line tLineNumber of tCurrentWatches set the watchedVariables to tCurrentWatches # Store the watch's status in the object so it is remembered between restarts etc debuggerUpdateWatchStatus tStack, tStackLineNumber, "inactive" end revDebuggerDeactivateWatch # Parameters # pObject : reference to the object to list watches for # Returns # A list of watches set on the specified object, in the format of the watchedVariables property. function revDebuggerListWatches pObject local tStack put debuggerTargetStack(pObject) into tStack local tWatches put revMetadataGet(tStack, kMetadataType, "watches") into tWatches local tMatchingWatches repeat for each line tWatch in tWatches if debuggerGetId(pObject) is item 1 of tWatch then put debuggerResolveId(item 1 of tWatch, tStack) & comma & item 2 to -1 of tWatch & return after tMatchingWatches end if end repeat delete the last char of tMatchingWatches return tMatchingWatches end revDebuggerListWatches function revDebuggerListWatchStates pObject local tStack put debuggerTargetStack(pObject) into tStack local tWatches put revMetadataGet(tStack, kMetadataType, "watches") into tWatches local tMatchingLineNumbers local tLineNumber put 1 into tLineNumber repeat for each line tWatch in tWatches if debuggerGetId(pObject) is item 1 of tWatch then put tLineNumber & return after tMatchingLineNumbers end if add 1 to tLineNumber end repeat delete the last char of tMatchingLineNumbers local tStates put revMetadataGet(tStack, kMetadataType, "watchstates") into tStates local tMatchingStates repeat for each line tMatchingLineNumber in tMatchingLineNumbers put line tMatchingLineNumber of tStates & return after tMatchingStates end repeat return tMatchingStates end revDebuggerListWatchStates # Parameters # pObject : reference to the object to list breakpoints for. # Description # Returns a list of the statuses of the breakpoints for pObject. # each status is either "active" or "inactive". These cannot be # set directly, but are set by using the revDebuggerActivateBreakpoint # and revDebuggerDeactiveBreakpoint commands. The statuses are returned # in the same order as the breakpoints list. function revDebuggerListBreakpointStates pObject local tStack put debuggerTargetStack(pObject) into tStack local tBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tBreakpoints local tLineNumber put 1 into tLineNumber local tMatchingLines repeat for each line tBreakpoint in tBreakpoints if debuggerGetId(pObject) = item 1 of tBreakpoint then put tLineNumber & return after tMatchingLines end if add 1 to tLineNumber end repeat delete the last char of tMatchingLines local tStates put revMetadataGet(tStack, kMetadataType, "breakpointstates") into tStates local tMatchingStates repeat for each line tMatchingLine in tMatchingLines put line tMatchingLine of tStates & return after tMatchingStates end repeat delete the last char of tMatchingStates return tMatchingStates end revDebuggerListBreakpointStates # Parameters # pObject : reference to the object to list breakpoints for. # Description # Returns a list of the conditions of the breakpoints for pObject. function revDebuggerListBreakpointConditions pObject local tStack put debuggerTargetStack(pObject) into tStack local tBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tBreakpoints local tLineNumber put 1 into tLineNumber local tMatchingLines repeat for each line tBreakpoint in tBreakpoints if debuggerGetId(pObject) = item 1 of tBreakpoint then put tLineNumber & return after tMatchingLines end if add 1 to tLineNumber end repeat delete the last char of tMatchingLines local tConditions put revMetadataGet(tStack, kMetadataType, "breakpointconditions") into tConditions local tMatchingConditions repeat for each line tMatchingLine in tMatchingLines put line tMatchingLine of tConditions & return after tMatchingConditions end repeat delete the last char of tMatchingConditions return tMatchingConditions end revDebuggerListBreakpointConditions # Parameters # @pScript : The script of the object to find an available line to break on. This is not mutated, its a reference for efficiency # pLineNumber : the number of the line to start the search from. This is *not* inclusive, i.e you must provide the number # of the line *before* the first line you wish to put a breakpoint on. The reason for this is line continuation # Returns # The number of the next available line after pLineNumber where a breakpoint can be placed in pScript. # If there is no appropriate line before the end of the script, 0 is returned. Note that pLineNumber must be a valid # line to put a breakpoint on itself, otherwise this may not return a valid line number, e.g. could be outside a handler. function revDebuggerNextAvailableBreakpoint @pScript, pLineNumber # For now we have to hack this without access to the parser local tMatchingLineNumber # If pLineNumber is 0, we check the first line of the script, otherwise the second line is the first # possible breakpoint position. Of course the first line cannot be a continuation, so we just check # it is not a comment. If the line doesn't match, resume the search as if the user had passed 1. local tLineNumber if pLineNumber = 0 then if token 1 of line 1 of pScript is not empty then return 1 else put 1 into tLineNumber end if else put pLineNumber into tLineNumber end if local tCurrentLineNumber put tLineNumber - 1 into tCurrentLineNumber local tText put line tLineNumber to -1 of pScript into tText local tContinuation put debuggerLineHasContinuation(line 1 of tText) into tContinuation local tInHandler repeat for each line tCurrentLine in line 2 to -1 of tText add 1 to tCurrentLineNumber # Detect if the line is a comment or the line is whitespace if token 1 of tCurrentLine is empty then next repeat end if # Detect if the line is a continuation of line tLineNumber if tContinuation then put debuggerLineHasContinuation(tCurrentLine) into tContinuation next repeat end if # Detect if the line is a variable declaration # (Check removed, I think this may actually be ok to allow breakpoints on) # if token 1 of tCurrentLine is among the words of "constant local global" then # next repeat # end if # With control structures, only the first line of the control structure, and the statements inside it # can be broken on. These intermediate parts of structures cannot be broken on. Note that "else if" is an # exception to this. if token 1 of tCurrentLine is among the words of "finally catch case else" then next repeat end if # The endings of control structures cannot be broken on (apart from handlers). if token 1 of tCurrentLine is "end" and token 2 of tCurrentLine is among the words of "repeat switch if try" then next repeat end if put tCurrentLineNumber into tMatchingLineNumber exit repeat end repeat if tMatchingLineNumber is empty then return 0 else # Add 1 because we started at line 2... return tMatchingLineNumber + 1 end if end revDebuggerNextAvailableBreakpoint ################################################################################ # # Debugger library internals # ################################################################################ # Stores the last contexts that was displayed in the script editor. Note that we store the entire call stack # in order to unambiguously identify each execution point. This is particularly important when dealing with recursion. local sLastDisplayedContexts # Parameters # pBreakpoint : the breakpoint to search for (object, line) # pBreakpoints : the list of breakpoints to search in # Returns # The line number that the specified breakpoint appears on in # pBreakpoints, or 0 if it does not appear. private function debuggerBreakpointOffset pBreakpoint, pBreakpoints set the wholeMatches to true return lineOffset(pBreakpoint, pBreakpoints) set the wholeMatches to false end debuggerBreakpointOffset # Parameters # pWatch : the watch to search for (object, handler, variable) # pWatches : the list of watches to search in private function debuggerWatchoffset pWatch, pWatches local tMatchString put pWatch & comma into tMatchString return lineOffset(tMatchString, pWatches) end debuggerWatchoffset # Parameters # pLine : a line of Revolution script # Returns # Whether or not pLine has a continuation private function debuggerLineHasContinuation pLine # First find if the line contains a continuation char among its words, if not then we're done. local tContinuationCharOffset put wordOffset("\", pLine) into tContinuationCharOffset if tContinuationCharOffset = 0 then return false end if # Nothing apart from a comment can legally come after the continuation char so if we # have one then the result is probably true, however we have to ensure that the char # we found is not in a comment itself. This cannot easily be done without access to the # parser in the engine, however make a simple attempt here. repeat for each word tWord in pLine # Miss out literals as they can contain any char if char 1 of tWord is quote and char -1 of tWord is quote then next repeat end if # If we find a word containing the continuation char, find out if there is a comment # char before it. If so, return false. Otherwise return true local tOffset put offset("\", tWord) into tOffset if tOffset <> 0 then local tPrefix put char 1 to tOffset of tWord into tPrefix if tPrefix contains "#" or tPrefix contains "//" or tPrefix contains "--" then return false else return true end if end if end repeat end debuggerLineHasContinuation # Parameters # pObject : reference to the object owning the breakpoint # pLine : the line number that the breakpoint is on # pContext : the debug context to evaluate the condition in # Description # Evaluates the specified breakpoint's condition and returns whether to break or not. # If the breakpoint has no condition attached to to, returns true, otherwise it depends on the condition. private function debuggerEvaluateCondition pObject, pLine, pContext local tStack put debuggerTargetStack(pObject) into tStack local tBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tBreakpoints local tBreakpoint put debuggerGetId(pObject) & comma & pLine into tBreakpoint local tLineNumber put debuggerBreakpointOffset(tBreakpoint, tBreakpoints) into tLineNumber if tLineNumber = 0 then # The debugger library does not know about this breakpoint but this is not neccessarily an error, # it could be a script breakpoint or one that the user manually set. Also it could be an internal breakpoint # used by the debugger library to step over code faster. So here we act as though no condition was set. return true end if local tConditions put revMetadataGet(tStack, kMetadataType, "breakpointconditions") into tConditions local tCondition put line tLineNumber of tConditions into tCondition #log "Condition found for specified breakpoint: " & tCondition if tCondition is empty then return true end if local tResult set the debugContext to pContext debugDo "return " & tCondition put the result into tResult set the debugContext to empty #log "Result of condition evaluation: " & tResult if tResult then return true else return false end if end debuggerEvaluateCondition private function debuggerTargetStack pObject local tStackName put revTargetStack(pObject) into tStackName return the long id of stack tStackName end debuggerTargetStack # Implements the revDebuggerAddBreakpoint and revDebuggerAddConditionalBreakpoint # commands, please see the comments above them for semantics and parameters. private command debuggerAddBreakpoint pObject, pLine, pCondition local tStack put debuggerTargetStack(pObject) into tStack local tStackBreakpoints put revMetadataGet(tStack, kMetadataType, "breakpoints") into tStackBreakpoints if the number of lines of tStackBreakpoints >= kObjectBreakpointLimit then # Return an error here as the other option, removal of other breakpoints # to make room could potentially confuse the user. return "Maximum number of breakpoints reached on object" end if local tNewBreakpoint put debuggerGetId(pObject) & comma & pLine into tNewBreakpoint if tStackBreakpoints is empty then put tNewBreakpoint into tStackBreakpoints else put tStackBreakpoints & return & tNewBreakpoint into tStackBreakpoints end if revMetadataSet tStack, kMetadataType, "breakpoints", tStackBreakpoints # Update the breakpoint state, this is inactive for newly added breakpoints local tStates put revMetadataGet(tStack, kMetadataType, "breakpointstates") into tStates put "inactive" into line (the number of lines of tStackBreakpoints) of tStates revMetadataSet tStack, kMetadataType, "breakpointstates", tStates if pCondition is empty then exit debuggerAddBreakpoint end if # Apply the condition if given. local tStackConditions put revMetadataGet(tStack, kMetadataType, "breakpointconditions") into tStackConditions put pCondition into line (the number of lines of tStackBreakpoints) of tStackConditions revMetadataSet tStack, kMetadataType, "breakpointconditions", tStackConditions debuggerCleanBreakpoints tStack end debuggerAddBreakpoint # Parameters # pStack : reference to the stack to clean watches for # Description # Cleans up the specified stack's watch related metadata by removing # watches that cannot be resolved (e.g. because the object was deleted) # and removing any duplicates. private command debuggerCleanWatches pStack local tWatches put revMetadataGet(pStack, kMetadataType, "watches") into tWatches local tStates put revMetadataGet(pStack, kMetadataType, "watchstates") into tStates local tLineNumber put 1 into tLineNumber local tCleanedWatches, tCleanedStates repeat for each line tWatch in tWatches try get debuggerResolveId(item 1 of tWatch, pStack) catch tError # debuggerResolveId will fail if the watch cannot be resolved, # this means the object has somehow been deleted, moved etc without # the debugger library knowing about. This watch should be removed. next repeat end try # Remove duplicates if debuggerWatchOffset(tWatch, tCleanedWatches) <> 0 then next repeat end if put tWatch & return after tCleanedWatches put line tLineNumber of tStates & return after tCleanedStates add 1 to tLineNumber end repeat delete the last char of tCleanedWatches delete the last char of tCleanedStates revMetadataSet pStack, kMetadataType, "watches", tCleanedWatches revMetadataSet pStack, kMetadataType, "watchstates", tCleanedStates end debuggerCleanWatches # Parameters # pStack : reference to the stack to clean breakpoints for # Description # Cleans up the specified stack's breakpoint related metadata by removing # breakpoints that cannot be resolved (e.g. because the object was deleted) # and removing any duplicates. private command debuggerCleanBreakpoints pStack local tBreakpoints put revMetadataGet(pStack, kMetadataType, "breakpoints") into tBreakpoints local tStates put revMetadataGet(pStack, kMetadataType, "breakpointstates") into tStates local tConditions put revMetadataGet(pStack, kMetadataType, "breakpointconditions") into tConditions local tLineNumber put 1 into tLineNumber local tCleanedBreakpoints, tCleanedStates, tCleanedConditions repeat for each line tBreakpoint in tBreakpoints try get debuggerResolveId(item 1 of tBreakpoint, pStack) catch tError # debuggerResolveId will fail if the breakpoint cannot be resolved, # this means the object has somehow been deleted, moved etc without # the debugger library knowing about. This breakpoint should be removed. next repeat end try # Remove duplicates if tBreakpoint is among the lines of tCleanedBreakpoints then next repeat end if put tBreakpoint & return after tCleanedBreakpoints put line tLineNumber of tStates & return after tCleanedStates put line tLineNumber of tConditions & return after tCleanedConditions add 1 to tLineNumber end repeat delete the last char of tCleanedBreakpoints delete the last char of tCleanedStates delete the last char of tCleanedConditions revMetadataSet pStack, kMetadataType, "breakpoints", tCleanedBreakpoints revMetadataSet pStack, kMetadataType, "breakpointstates", tCleanedStates revMetadataSet pStack, kMetadataType, "breakpointconditions", tCleanedConditions end debuggerCleanBreakpoints # Parameters # pStack : reference to the stack to update # pBreakpointNumber : the lineoffset of the breakpoint to edit in the breakpoints list of pStack # pStatus : the breakpoint status to set. This can be "active" or "inactive". # Description # Sets a breakpoint's status to pStatus. private command debuggerUpdateBreakpointStatus pStack, pBreakpointNumber, pStatus local tObjectBreakpointStatus put revMetadataGet(pStack, kMetadataType, "breakpointstates") into tObjectBreakpointStatus put pStatus into line pBreakpointNumber of tObjectBreakpointStatus revMetadataSet pStack, kMetadataType, "breakpointstates", tObjectBreakpointStatus end debuggerUpdateBreakpointStatus # Parameters # pStack : reference to the stack to update # pBreakpointNumber : the lineoffset of the breakpoint to edit in the breakpoints list of pStack # pCondition : the breakpoint condition to set. This is a Revolution expression to be evaluated in the # breakpoint's context and should evaluate to true or false. # Description # Sets a breakpoint's condition to pCondition. private command debuggerUpdateBreakpointCondition pStack, pBreakpointNumber, pCondition local tConditions put revMetadataGet(pStack, kMetadataType, "breakpointconditions") into tConditions put pCondition into line pBreakpointNumber of tConditions revMetadataSet pStack, kMetadataType, "breakpointconditions", tConditions end debuggerUpdateBreakpointCondition private command debuggerUpdateWatchStatus pStack, pWatchNumber, pStatus local tStates put revMetadataGet(pStack, kMetadataType, "watchstates") into tStates put pStatus into line pWatchNumber of tStates revMetadataSet pStack, kMetadataType, "watchstates", tStates end debuggerUpdateWatchStatus # Paramaeters # pId : the debugger id of an object used to store a breakpoint. # pStack : reference to the stack that the id is owned by (or is) # Returns # The long id of the object that pId refers to # Description # pId is either the short id of a control in pStack, or 0 if the breakpoint # being resolved is in the stack script. private function debuggerResolveId pId, pStack if pId is 0 then return the long id of pStack else # As the object could be a card, we attempt that first if there is a card id pId of pStack then return the long id of card id pId of pStack else return the long id control id pId of pStack end if end if end debuggerResolveId # Parameters # pObject : reference to the object to get the debugger id for # Returns # The debugger id for the specified object. This is what is stored by the debugger # with breakpoints set on the object, and used to determine which object each # breakpoint is associated with. The debugger id is the short id of the object if # it is a control or a card. If the object is a stack, the debugger id is 0. private function debuggerGetId pObject if word 1 of the name of pObject is "stack" then return 0 end if return the id of pObject end debuggerGetId # Returns # Whether or not the debugger is enabled. This is currently determined by the "Script Debug Mode" # setting in the Revolution preferences stack. private function debuggerEnabled return (the cREVScriptDebugMode of stack "revPreferences" is true) end debuggerEnabled # Parameters # pStack : reference to a stack # Returns # Whether or not the debugger is allowed to debug the specified stack in # the current circumstances. private function debuggerStackAllowed pStack global gREVDevelopment if gREVDEvelopment then # With gREVDevelopment allow all stacks to be debugged except the debugger, as doing this will probably not work anyway. if the short name of pStack is "revDebugger" then return false else return true end if end if # This check is flawed and needs to be sorted out... if char 1 to 3 of the short name of pStack is "rev" or the short name of pStack is among the items of "Message Box,Home,Answer Dialog,Ask Dialog,File Selector" then return false else return true end if end debuggerStackAllowed # Parameters # pObject : reference to the object owning the executing code # pHandler : the name of the handler executing # pLine : the number of line about to be executed # pState : either "debug" if still debugging or "edit" if debugging has finished. # Description # Called when the script editor may need to be updated because a new line # of code is about to be executed in the debugger. If there is no script # editor open for pObject then does nothing. # Otherwise tells the script editor to display the appropriate line etc. private command debuggerUpdateScriptEditor pObject, pHandler, pLine, pState local tScriptEditor put revScriptEditor(the long id of pObject) into tScriptEditor if tScriptEditor is empty then debuggerShowScript pObject end if put revScriptEditor(the long id of pObject) into tScriptEditor put revDebuggerContexts() into sLastDisplayedContexts local tMode send "revSEGetMode" to stack tScriptEditor put the result into tMode if pState is not tMode then # This must be sent in time to allow the script editor a chance to set its current object, # otherwise an infinite loop could occur. send "revSESetMode pState" to stack tScriptEditor in 0 milliseconds end if local tFalseString put "false" into tFalseString # These must be sent in time to allow the script editor a chance to set its current object, # otherwise an infinite loop could occur. send "revSEGoExecutionPoint pObject, pLine, true" to stack tScriptEditor in 0 milliseconds send "revSEUpdate tFalseString" to stack tScriptEditor in 0 milliseconds # OK-2008-08-18 : Bug 6935 - Toplevel / uniconify the script editor here. revGoScriptEditor the name of stack tScriptEditor end debuggerUpdateScriptEditor private function debuggerErrorsSuppressed global gREVSuppressErrors return (gREVSuppressErrors is true) end debuggerErrorsSuppressed private function revScriptEditors return revListScriptEditors() end revScriptEditors private command debuggerShowScript pObject edit the script of pObject end debuggerShowScript private command log pMessage --put pMessage & return after msg --put pMessage & return after url "file:C:/Users/Oliver/Desktop/Debugger Log.txt" end log # Description # Shows revErrorDisplay in response to a trace error. # This has been hacked in for now to avoid modifying revErrorDisplay. private command debuggerShowErrorDialog pObject, pHandler, pLine, pError answer error "An execution error ocurred in the script of the object : " & the short name of pObject & return & \ "The error was on line " & pLine & " in the " & pHandler & " handler. The error was: " & return & \ pError & " What would you like to do?" with "Ignore" or "Debug" or "Script" if it is "Ignore" then revDebuggerStop exit debuggerShowErrorDialog end if if it is "Script" then revDebuggerStop debuggerUpdateScriptEditor pObject, pHandler, pLine, "edit" end if if it is "Debug" then debuggerUpdateScriptEditor pObject, pHandler, pLine, "debug" end if end debuggerShowErrorDialog private command debuggerSaveExecutionPoint pObject, pHandler, pLine put pObject into sLastObject put pLine into sLastLine put pHandler into sLastHandler end debuggerSaveExecutionPoint ################################################################################ # # Event handlers # ################################################################################ # Description # Sent every time a line is about to be executed when tracing . If the stack containing the # code cannot be debugged, then continues executing the code without # taking any action. Otherwise searches for a script editor that might # be editing the target object, and sends it appropriate messages to tell # it which line is about to execute. (Also needs to do something with breakpoints) # If the last debug action was "Step Over" rather than "Step Into", checks # if the current execution context is the one after the line where "Step Over" # was called from, then updates the script editor. If the last debug action # was "Step Into", always updates the script editor. on trace pHandler, pLine, pPosition local tTarget put the long id of the target into tTarget debuggerSaveExecutionPoint tTarget, pHandler, pLine local tStack put debuggerTargetStack(tTarget) into tStack local tCurrentContexts put revDebuggerContexts() into tCurrentContexts local tNextContextCount if not debuggerStackAllowed(tStack) then # If this happens in a trace message it means either the user has stepped over / into IDE code, # or they have changed gREVDevelopment to false from true while debugging. In this case, we # step out of the IDE code to allow the user code to continue running. Note that this has certain # unresolved issues, for instance if a user script uses a "send" command, and the message is intercepted # by an IDE frontscript, we'll end up here, but stepping out would in fact be incorrect and results in the # debugger being unable to follow the send. (Bug #2996). put item 1 line 1 of tCurrentContexts - 1 into tNextContextCount set the traceUntil to tNextContextCount set the traceReturn to true exit trace end if if sLastTraceMode is "Step Into" then debuggerUpdateScriptEditor tTarget, pHandler, pLine, "debug" else if sLastTraceMode is "Step Over" then local tLastHandler put item -2 of line 1 of sLastDisplayedContexts into tLastHandler if line 2 to -1 of sLastDisplayedContexts is line 2 to -1 of tCurrentContexts and pHandler is tLastHandler then debuggerUpdateScriptEditor tTarget, pHandler, pLine, "debug" else # Calculate the number of execution contexts that there should be before we get the next trace message. # I'm not certain why this needs to be -2 (would expect it to be -1), perhaps because the check is carried out before the exiting handler # is removed the the call stack?? put(item 1 of line 1 of tCurrentContexts) - 2 into tNextContextCount set the traceUntil to tNextContextCount set the traceReturn to true end if else if sLastTraceMode is "Step Out" then if line 3 to -1 of sLastDisplayedContexts is line 2 to -1 of revDebuggerContexts() and pHandler is item -2 of line 2 of sLastDisplayedContexts then debuggerUpdateScriptEditor tTarget, pHandler, pLine, "debug" else put item 1 line 1 of tCurrentContexts - 2 into tNextContextCount set the traceUntil to tNextContextCount set the traceReturn to true end if end if end trace # Description # Sent when tracing has finished, i.e. there is nothing left to debug. Tells # all open script editors to switch to edit mode, then does the debugger run # action. on traceDone repeat for each line tScriptEditor in revScriptEditors() send "revSESetMode edit" to tScriptEditor end repeat revDebuggerRun end traceDone # Parameters # pHandler : the name of the handler that threw the error # pLineNumber : the number of line that the error was on # pPosition : the char number that the error was on # pError : the error details # Description # Sent when an execution error occurs when debugging and not inside a try block. # If the debugger is not enabled, does nothing. If the error was thrown by a user # via the throw command, or messages are suppressed, exits to top. # Otherwise, launches the debugger, showing the current execution context. on traceError pHandler, pLine, pPosition, pError local tTarget put the long id of the target into tTarget debuggerSaveExecutionPoint tTarget, pHandler, pLine ######################### close printing if not debuggerEnabled() then pass traceError end if if debuggerErrorsSuppressed() or pError is empty or the waitDepth > 2 then exit to top end if local tStack put debuggerTargetStack(tTarget) into tStack if not debuggerStackAllowed(tStack) then revDebuggerStop exit traceError end if debuggerUpdateScriptEditor tTarget, pHandler, pLine, "debug" set the traceStack to the short name of tStack local tEditor put revScriptEditor(tTarget) into tEditor # OK-2008-07-10 : This needs to be sent in time so that it arrives after the script # editor has finished initializing itself. send "revSEDisplayExecutionError pError, tTarget" to stack tEditor in 0 milliseconds end traceError # Parameters # pHandler : the handler that the breakpoint was triggered in # pLine : the line number that the breakpoint was on # Description # Sent when a breakpoint triggers. If the debugger is not enabled, does # nothing. Otherwise, opens a script editor for the object (unless one is # already open) and updates it appropriately. on traceBreak pHandler, pLine local tTarget put the long id of the target into tTarget debuggerSaveExecutionPoint tTarget, pHandler, pLine if not debuggerEnabled() then pass traceBreak end if local tStack put debuggerTargetStack(tTarget) into tStack if not debuggerStackAllowed(tStack) then revDebuggerRun exit traceBreak end if local tContext put tTarget & comma & pHandler & comma & pLine into tContext if debuggerEvaluateCondition(tTarget, pLine, tContext) then set the traceStack to the short name of tStack debuggerShowScript tTarget debuggerUpdateScriptEditor tTarget, pHandler, pLine, "debug" else set the traceReturn to true end if end traceBreak on updateVariable pLine, pHandler, pValue traceBreak pHandler, pLine end updateVariable altPatchScript) --> INSERT BY CHIPP WALTERS repeat for each item I in the globalNames try do "global" && I catch tErr #answer t end try end repeat --> END INSERT --> COMMENT OUT BY CHIPP WALTERS -- do "global" && the globalNames --> END COMMENT OUTaltDebugToReplace#sort lines of tGlobalsRaw ascendingVista 64 Patch  U Segoe UIcREVGeometryCachestackID1011 cREVGeneralbreakpointconditions breakpointsbreakpointstatesAlreadyHiddenfalse @ cREVGeometryCacheIDs122551836463210041225522750712100912255222382791006cREVGeometrycacheordertotal3 cREVGeneralscripteditorvscroll0 Patch Revep on mouseUp if "$ProgramFiles(x86)" is not among the items of the globalNames then answer information "No patch for you! You are not running Vista 64." exit to top end if put "" put "" into fld "Message Field" of stack "Message Box" put "" into fld "Results" of stack "Message Box" put the altPatchScript of this stack into tScript put the altTextToReplace of this stack into tTextToReplace --> PATCH MESSAGE FIELD SCRIPT put the script of fld "Message Field" of stack "Message Box" into t1 if "Chipp Walters" is in t1 then answer information "Message Box Field already patched for Vista 64!" else put (t1 = the altOrigFieldScript of this stack) into tOKtoPatch if tOKtoPatch <> true then answer warning "It appears there have been changes made to the Message Box stack. We suggest you NOT CONTINUE!" with "NOT CONTINUE" or "Try Anyway" if it is "Try Anyway" then put true into tOKtoPatch if it is "NOT CONTINUE" then exit to top end if if tOKtoPatch is true then set the altOrigFieldScript of this stack to t1 replace tTextToReplace with tScript in t1 set the script of fld "Message Field" of stack "Message Box" to t1 save this stack save stack "Message Box" end if end if --> PATCH MESSAGE BOX STACK SCRIPT put the script of stack "Message Box" into t2 if "Chipp Walters" is in t2 then answer information "Message Box already patched for Vista 64!" else put (t2 = the altOrigStackScript of this stack) into tOKtoPatch if tOKtoPatch <> true then answer warning "It appears there have been changes made to the Message Box stack. We suggest you NOT CONTINUE!" with "NOT CONTINUE" or "Try Anyway" if it is "Try Anyway" then put true into tOKtoPatch if it is "NOT CONTINUE" then exit to top end if if tOKtoPatch is true then set the altOrigStackScript of this stack to t2 replace tTextToReplace with tScript in t2 set the script of stack "Message Box" to t2 save this stack save stack "Message Box" end if end if --> PATCH DEBUGGER put the script of stack "revDebugger" into t3 if "Chipp Walters" is in t3 then answer information "revDebugger already patched for Vista 64!" else put (t3 = the altOrigDebugScript of this stack) into tOKtoPatch if tOKtoPatch <> true then answer warning "It appears there have been changes made to the revDebug stack. We suggest you NOT CONTINUE!" with "NOT CONTINUE" or "Try Anyway" if it is "Try Anyway" then put true into tOKtoPatch if it is "NOT CONTINUE" then exit to top end if if tOKtoPatch is true then set the altOrigDebugScript of this stack to t3 put the altRevDebugPatch of this stack into tScript put the altDebugToReplace of this stack into tTextToReplace replace tTextToReplace with tScript in t3 set the script of stack "revDebugger" to t3 save this stack save stack "revDebugger" end if end if answer information "Successfully Completed!" end mouseUp <2$Patch Rev IDE to Work with Vista 64 cREVGeneralscripteditorvscroll761 revUniqueID 1225518364632scripteditorselection3133  Revert Revepon mouseUp if "$ProgramFiles(x86)" is not among the items of the globalNames then answer information "No revert for you! You are not running Vista 64." exit to top end if put "" put "" into fld "Message Field" of stack "Message Box" put "" into fld "Results" of stack "Message Box" put the script of fld "Message Field" of stack "Message Box" into t1 if "Chipp Walters" is in t1 then set the script of fld "Message Field" of stack "Message Box" to the altOrigFieldScript of this stack end if put the script of stack "Message Box" into t2 if "Chipp Walters" is in t2 then set the script of stack "Message Box" to the altOrigStackScript of this stack end if save stack "Message Box" put the script of stack "revDebugger" into t2 if "Chipp Walters" is in t2 then set the script of stack "revDebugger" to the altOrigDebugScript of this stack end if save stack "revDebugger" answer information "Message Box returned to original script." end mouseUp ==0Revert to Original Rev IDE cREVGeneral revUniqueID 1225522238279scripteditorvscroll0scripteditorselection938 Field)`&_L cREVGeneral revUniqueID 1225522750712  'created by Chipp Walters, Altuit, Inc. Nov 1, 2008 /This patches the Message Box so that it works. 5And patches the revDebugger frontScript so it works.  `@a`