Merge branch 'var-export' into development

internal/c/libqb.cpp

@@ -5397,6 +5397,14 @@ extern uint32 error_retry;
 
 void sub__echo(qbs *message);
 
+void unlockvWatchHandle() {
+    if (vwatch>0) vwatch=-1;
+}
+
+int32 vWatchHandle() {
+    return vwatch;
+}
+
 void sub__assert(int32 expression, qbs *assert_message, int32 passed) {
     if (asserts==0) return;
     if (expression==0) {
@@ -13096,7 +13104,11 @@ void sub_close(int32 i2,int32 passed){
     
     
     for (i=1;i<=special_handles->indexes;i++){
-        sub_close(-i-1,1);
+        if (vwatch>0 && vwatch==i) {
+            //keep connection to the IDE open for $DEBUG mode
+        } else {
+            sub_close(-i-1,1);
+        }
     }
     
     
@@ -21892,7 +21904,11 @@ void sub_put2(int32 i,int64 offset,void *element,int32 passed){
             if ((method==0)||(method==1)){
                 
                 if (parts<2) return -1;
-                if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("TCP/IP"))==0) return -1;
+                if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("TCP/IP"))==0) {
+                    if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("QB64IDE"))==0 || vwatch!=-1) {
+                        return -1;
+                    }
+                }
                 
                 d=func_val(info_part[2]);
                 port=qbr_double_to_long(d);//***assume*** port number is within valid range
@@ -21923,6 +21939,7 @@ void sub_put2(int32 i,int64 offset,void *element,int32 passed){
                     //init stream
                     my_stream_struct->in=NULL; my_stream_struct->in_size=0; my_stream_struct->in_limit=0;
                     
+                    if (vwatch==-1) vwatch=my_handle;
                     return my_handle;
                 }//client
                 

internal/c/qbx.cpp

@@ -12,6 +12,9 @@ extern void sub__consolefont(qbs* FontName, int FontSize);
 extern void sub__console_cursor(int32 visible, int32 cursorsize, int32 passed);
 extern int32 func__getconsoleinput();
 
+extern void unlockvWatchHandle();
+extern int32 vWatchHandle();
+
 #ifdef DEPENDENCY_ZLIB
     #include <zlib.h>
     qbs *func__deflate(qbs *text);

source/ide/ide_methods.bas

@@ -6410,6 +6410,8 @@ SUB DebugMode
     noFocusMessage = -1
 
     DO 'main loop
+        IF _EXIT THEN ideexit = 1: GOTO requestQuit
+
         bkpidecy = idecy
         WHILE _MOUSEINPUT: idecy = idecy + _MOUSEWHEEL * 3: WEND
 
@@ -6656,6 +6658,7 @@ SUB DebugMode
                 r$ = idesubs
                 PCOPY 3, 0: SCREEN , , 3, 0
                 GOSUB UpdateDisplay
+                WHILE _MOUSEINPUT: WEND
             CASE 15872 'F4
                 IF PauseMode THEN
                     requestCallStack:
@@ -6668,9 +6671,13 @@ SUB DebugMode
                     setStatusMessage 1, "Requesting call stack...", 7
 
                     start! = TIMER
+                    callStackLength = -1
                     DO
                         GOSUB GetCommand
-                        IF cmd$ = "call stack size" THEN callStackLength = CVL(value$)
+                        IF cmd$ = "call stack size" THEN
+                            callStackLength = CVL(value$)
+                            IF callStackLength = 0 THEN EXIT DO
+                        END IF
                         _LIMIT 100
                     LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout
 
@@ -6678,13 +6685,20 @@ SUB DebugMode
                         'display call stack
                         callstacklist$ = value$
                         ShowCallStack:
-                        retval = idecallstackbox
-                        PCOPY 3, 0: SCREEN , , 3, 0
                         clearStatusWindow 0
                         setStatusMessage 1, "Paused.", 2
+                        retval = idecallstackbox
+                        PCOPY 3, 0: SCREEN , , 3, 0
+                        WHILE _MOUSEINPUT: WEND
                     ELSE
-                        clearStatusWindow 0
+                        IF callStackLength = -1 THEN
-                        setStatusMessage 1, "Error retrieving call stack.", 2
+                            callStackLength = 0
+                            clearStatusWindow 0
+                            setStatusMessage 1, "Error retrieving call stack.", 2
+                        ELSEIF callStackLength = 0 THEN
+                            clearStatusWindow 0
+                            setStatusMessage 1, "No call stack log available.", 2
+                        END IF
                     END IF
                     noFocusMessage = NOT noFocusMessage
                 END IF
@@ -6757,8 +6771,9 @@ SUB DebugMode
                     IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
                         result = idegetlinenumberbox("Run To Line", idecy)
                         PCOPY 3, 0: SCREEN , , 3, 0
+                        WHILE _MOUSEINPUT: WEND
                         requestRunToThisLine:
-                        IF result > 0 AND result < iden THEN
+                        IF result > 0 AND result <= iden THEN
                             PauseMode = 0
                             debugnextline = 0
                             cmd$ = "run to line:" + MKL$(result)
@@ -6771,8 +6786,9 @@ SUB DebugMode
                     ELSE
                         result = idegetlinenumberbox("Set Next Line", idecy)
                         PCOPY 3, 0: SCREEN , , 3, 0
+                        WHILE _MOUSEINPUT: WEND
                         requestSetNextLine:
-                        IF result > 0 AND result < iden THEN
+                        IF result > 0 AND result <= iden THEN
                             cmd$ = "set next line:" + MKL$(result)
                             GOSUB SendCommand
                         END IF
@@ -6782,6 +6798,7 @@ SUB DebugMode
                 IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
                     result = idegetlinenumberbox("Skip Line", idecy)
                     PCOPY 3, 0: SCREEN , , 3, 0
+                    WHILE _MOUSEINPUT: WEND
                     requestToggleSkipLine:
                     IF result > 0 AND result <= iden THEN
                         IdeSkipLines(result) = NOT IdeSkipLines(result)
@@ -6838,15 +6855,19 @@ SUB DebugMode
                 'requested when the program is about to quit or
                 'when an error just occurred
                 callStackLength = CVL(value$)
-                start! = TIMER
+                IF callStackLength THEN
-                DO
+                    start! = TIMER
-                    GOSUB GetCommand
+                    DO
-                    _LIMIT 100
+                        GOSUB GetCommand
-                LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout
+                        _LIMIT 100
+                    LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout
 
-                IF cmd$ = "call stack" THEN
+                    IF cmd$ = "call stack" THEN
-                    'store call stack
+                        'store call stack
-                    callstacklist$ = value$
+                        callstacklist$ = value$
+                    END IF
+                ELSE
+                    callstacklist$ = ""
                 END IF
         END SELECT
 
@@ -6906,19 +6927,25 @@ FUNCTION idecallstackbox
     '-------- init --------
 
     i = 0
-    idepar p, idewx - 8, idewy + idesubwindow - 6, "$DEBUG MODE"
+
+    dialogHeight = callStackLength + 4
+    IF dialogHeight > idewy + idesubwindow - 6 THEN
+        dialogHeight = idewy + idesubwindow - 6
+    END IF
+
+    idepar p, idewx - 8, dialogHeight, "$DEBUG MODE"
 
     i = i + 1
     o(i).typ = 2
     o(i).y = 2
-    o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 10
+    o(i).w = idewx - 12: o(i).h = dialogHeight - 4
     o(i).txt = idenewtxt(callstacklist$)
     o(i).sel = callStackLength
     o(i).nam = idenewtxt("Call Stack")
 
     i = i + 1
     o(i).typ = 3
-    o(i).y = idewy + idesubwindow - 6
+    o(i).y = dialogHeight
     o(i).txt = idenewtxt("#Close")
     o(i).dft = 1
 
@@ -8270,6 +8297,7 @@ FUNCTION idegetline$ (i)
 END FUNCTION
 
 SUB idecentercurrentline
+    IF iden <= idewy - 8 THEN EXIT SUB
     idesy = idecy - (idewy - 8) \ 2
     IF idesy < 1 THEN idesy = 1
 END SUB
@@ -8748,6 +8776,7 @@ FUNCTION idefiledialog$(programname$, mode AS _BYTE)
         '-------- custom display changes --------
         COLOR 0, 7: _PRINTSTRING (p.x + 2, p.y + 4), "Path: "
         a$ = path$
+        IF LEN(a$) = 2 AND RIGHT$(a$, 1) = ":" THEN a$ = a$ + "\"
         w = p.w - 8
         IF LEN(a$) > w - 3 THEN a$ = STRING$(3, 250) + RIGHT$(a$, w - 3)
         _PRINTSTRING (p.x + 2 + 6, p.y + 4), a$
@@ -10074,13 +10103,17 @@ FUNCTION idesubs$
 
     '72,19
     i = 0
-    idepar p, idewx - 8, idewy + idesubwindow - 6, "SUBs"
+    dialogHeight = TotalSUBs + 4
+    IF dialogHeight > idewy + idesubwindow - 6 THEN
+        dialogHeight = idewy + idesubwindow - 6
+    END IF
+    idepar p, idewx - 8, dialogHeight, "SUBs"
 
     i = i + 1
     o(i).typ = 2
     o(i).y = 1
     '68
-    o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 9
+    o(i).w = idewx - 12: o(i).h = dialogHeight - 3
     IF SortedSubsFlag = 0 THEN
         IF IDESubsLength THEN
             o(i).txt = idenewtxt(lSized$)
@@ -10121,14 +10154,14 @@ FUNCTION idesubs$
     i = i + 1
     o(i).typ = 4 'check box
     o(i).x = 2
-    o(i).y = idewy + idesubwindow - 6
+    o(i).y = dialogHeight
     o(i).nam = idenewtxt("#Line Count")
     o(i).sel = IDESubsLength
 
     i = i + 1
     o(i).typ = 4 'check box
     o(i).x = 18
-    o(i).y = idewy + idesubwindow - 6
+    o(i).y = dialogHeight
     o(i).nam = idenewtxt("#Sort")
     o(i).sel = SortedSubsFlag
 
@@ -10136,8 +10169,12 @@ FUNCTION idesubs$
     o(i).typ = 3
     o(i).x = p.x + p.w - 26
     o(i).w = 26
-    o(i).y = idewy + idesubwindow - 6
+    o(i).y = dialogHeight
-    o(i).txt = idenewtxt("#Edit" + sep + "#Cancel")
+    IF IdeDebugMode = 0 THEN
+        o(i).txt = idenewtxt("#Edit" + sep + "#Cancel")
+    ELSE
+        o(i).txt = idenewtxt("#View" + sep + "#Cancel")
+    END IF
     o(i).dft = 1
 
 
@@ -10358,19 +10395,23 @@ FUNCTION idelanguagebox
     l$ = UCASE$(l$)
 
     i = 0
-    idepar p, idewx - 8, idewy + idesubwindow - 6, "Language"
+    dialogHeight = idecpnum + 4
+    IF dialogHeight > idewy + idesubwindow - 6 THEN
+        dialogHeight = idewy + idesubwindow - 6
+    END IF
+    idepar p, idewx - 8, dialogHeight, "Language"
 
     i = i + 1
     o(i).typ = 2
     o(i).y = 2
-    o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 10
+    o(i).w = idewx - 12: o(i).h = dialogheight - 4
     o(i).txt = idenewtxt(l$)
     o(i).sel = 1: IF idecpindex THEN o(i).sel = idecpindex
     o(i).nam = idenewtxt("Code Pages")
 
     i = i + 1
     o(i).typ = 3
-    o(i).y = idewy + idesubwindow - 6
+    o(i).y = dialogheight
     o(i).txt = idenewtxt("#OK" + sep + "#Cancel")
     o(i).dft = 1
 
@@ -11293,7 +11334,7 @@ FUNCTION idezchangepath$ (path$, newpath$)
         END IF
         'change drive
         IF LEN(newpath$) = 2 AND RIGHT$(newpath$, 1) = ":" THEN
-            idezchangepath$ = newpath$ + "\"
+            idezchangepath$ = newpath$
             EXIT FUNCTION
         END IF
         idezchangepath$ = path$ + "\" + newpath$

source/qb64.bas

@@ -27,8 +27,11 @@ REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name
 Set_OrderOfOperations
 
 DIM SHARED vWatchOn, vWatchRecompileAttempts, vWatchDesiredState, vWatchErrorCall$
-DIM SHARED vWatchNewVariable$
+DIM SHARED vWatchNewVariable$, vWatchVariableExclusions$
 vWatchErrorCall$ = "if (stop_program) {*__LONG_VWATCH_LINENUMBER=0; SUB_VWATCH((ptrszint*)vwatch_local_vars);};if(new_error){bkp_new_error=new_error;new_error=0;*__LONG_VWATCH_LINENUMBER=-1; SUB_VWATCH((ptrszint*)vwatch_local_vars);new_error=bkp_new_error;};"
+vWatchVariableExclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__LONG_VWATCH_GOTO@" + _
+              "@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _
+              "@__ARRAY_BYTE_VWATCH_SKIPLINES@"
 
 DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState
 DIM SHARED opex_recompileAttempts, opex_desiredState
@@ -8765,7 +8768,16 @@ DO
         END IF
     END IF
 
+    IF firstelement$ = "CHAIN" THEN
+        IF vWatchOn THEN
+            addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Feature incompatible with $DEBUG MODE", "CHAIN"
+        END IF
+    END IF
+
     IF firstelement$ = "RUN" THEN 'RUN
+        IF vWatchOn THEN
+            addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Feature incompatible with $DEBUG MODE", "RUN"
+        END IF
         l$ = SCase$("Run")
         IF n = 1 THEN
             'no parameters
@@ -11395,6 +11407,9 @@ FOR i = 1 TO idn
             getid i
             IF Error_Happened THEN GOTO errmes
             IF id.arrayelements = -1 THEN GOTO clearerasereturned 'cannot erase non-existant array
+            IF INSTR(vWatchVariableExclusions$, "@" + RTRIM$(id.callname) + "@") > 0 THEN
+                GOTO clearerasereturned
+            END IF
             clearerasereturn = 1: GOTO clearerase
         END IF 'array
 
@@ -11417,14 +11432,18 @@ FOR i = 1 TO idn
                     PRINT #12, "memset((void*)(" + e$ + "->chr),0," + bytes$ + ");"
                     GOTO cleared
                 ELSE
-                    PRINT #12, e$ + "->len=0;"
+                    IF INSTR(vWatchVariableExclusions$, "@" + e$ + "@") = 0 AND LEFT$(e$, 12) <> "_SUB_VWATCH_" THEN
+                        PRINT #12, e$ + "->len=0;"
+                    END IF
                     GOTO cleared
                 END IF
             END IF
             IF typ AND ISUDT THEN
                 PRINT #12, "memset((void*)" + e$ + ",0," + bytes$ + ");"
             ELSE
-                PRINT #12, "*" + e$ + "=0;"
+                IF INSTR(vWatchVariableExclusions$, "@" + e$ + "@") = 0 AND LEFT$(e$, 12) <> "_SUB_VWATCH_" THEN
+                    PRINT #12, "*" + e$ + "=0;"
+                END IF
             END IF
             GOTO cleared
         END IF 'non-array variable
@@ -11695,7 +11714,7 @@ ELSE
 END IF
 
 IF vWatchOn THEN
-    PRINT #18, "int32 vwatch=1;"
+    PRINT #18, "int32 vwatch=-1;"
 ELSE
     PRINT #18, "int32 vwatch=0;"
 END IF
@@ -14197,17 +14216,10 @@ END SUB
 SUB vWatchVariable (this$, action AS _BYTE)
     STATIC totalLocalVariables AS LONG, localVariablesList$
     STATIC totalMainModuleVariables AS LONG, mainModuleVariablesList$
-    STATIC exclusions$
-
-    IF LEN(exclusions$) = 0 THEN
-        exclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__LONG_VWATCH_GOTO@" + _
-                      "@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _
-                      "@__ARRAY_BYTE_VWATCH_SKIPLINES@"
-    END IF
 
     SELECT CASE action
         CASE 0 'add
-            IF INSTR(exclusions$, "@" + this$ + "@") > 0 OR LEFT$(this$, 12) = "_SUB_VWATCH_" THEN
+            IF INSTR(vWatchVariableExclusions$, "@" + this$ + "@") > 0 OR LEFT$(this$, 12) = "_SUB_VWATCH_" THEN
                 EXIT SUB
             END IF
 

source/utilities/vwatch/vwatch.bm

@@ -13,6 +13,7 @@ SUB vwatch (localVariables AS _OFFSET)
     DECLARE LIBRARY
         SUB vwatch_stoptimers ALIAS stop_timers
         SUB vwatch_starttimers ALIAS start_timers
+        SUB unlockvWatchHandle
     END DECLARE
 
     IF bypass THEN EXIT SUB
@@ -35,7 +36,7 @@ SUB vwatch (localVariables AS _OFFSET)
             SELECT CASE cmd$
                 CASE "vwatch"
                     IF value$ <> "ok" THEN
-                        CLOSE #ideHost
+                        unlockvWatchHandle: CLOSE #ideHost
                         bypass = -1
                         EXIT SUB
                     END IF
@@ -48,7 +49,7 @@ SUB vwatch (localVariables AS _OFFSET)
                     IF LEN(value$) \ 4 <> breakpointCount THEN
                         cmd$ = "quit:Communication error."
                         GOSUB SendCommand
-                        CLOSE #ideHost
+                        unlockvWatchHandle: CLOSE #ideHost
                         bypass = -1
                         EXIT SUB
                     END IF
@@ -62,7 +63,7 @@ SUB vwatch (localVariables AS _OFFSET)
                     IF LEN(value$) \ 4 <> skipCount THEN
                         cmd$ = "quit:Communication error."
                         GOSUB SendCommand
-                        CLOSE #ideHost
+                        unlockvWatchHandle: CLOSE #ideHost
                         bypass = -1
                         EXIT SUB
                     END IF
@@ -85,7 +86,7 @@ SUB vwatch (localVariables AS _OFFSET)
         GOSUB SendCallStack
         cmd$ = "quit:Program ended."
         GOSUB SendCommand
-        CLOSE #ideHost
+        unlockvWatchHandle: CLOSE #ideHost
         bypass = -1
         ideHost = 0
         EXIT SUB
@@ -193,7 +194,7 @@ SUB vwatch (localVariables AS _OFFSET)
                 vwatch_starttimers
                 EXIT SUB
             CASE "free"
-                CLOSE #ideHost
+                unlockvWatchHandle: CLOSE #ideHost
                 ideHost = 0
                 bypass = -1
                 vwatch_starttimers
@@ -240,7 +241,7 @@ SUB vwatch (localVariables AS _OFFSET)
     start! = TIMER
     DO
         k& = _KEYHIT
-        ideHost = _OPENCLIENT("TCP/IP:" + ideport$ + ":localhost")
+        ideHost = _OPENCLIENT("QB64IDE:" + ideport$ + ":localhost")
         _LIMIT 30
     LOOP UNTIL k& = 27 OR ideHost <> 0 OR TIMER - start! > timeout
     IF ideHost = 0 THEN bypass = -1: EXIT SUB