From 741eefd32291ab470cdf861feb2515ec25748fcb Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 01:17:19 -0300 Subject: [PATCH 1/9] Simplifies and unifies Input Boxes (new FUNCTION ideinputbox$). --- source/ide/ide_methods.bas | 731 +++++++++---------------------------- 1 file changed, 170 insertions(+), 561 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index 30faebcc2..a1c21928a 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -5593,7 +5593,8 @@ FUNCTION ide2 (ignore) IF menu$(m, s) = "Modify #COMMAND$..." THEN PCOPY 2, 0 - retval = idemodifycommandbox + ModifyCOMMAND$ = " " + ideinputbox$("Modify COMMAND$", "#Enter text for COMMAND$", _TRIM$(ModifyCOMMAND$), "", 60, 0) + IF _TRIM$(ModifyCOMMAND$) = "" THEN ModifyCOMMAND$ = "" 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop @@ -7361,7 +7362,7 @@ SUB ideinsline (i, text$) iden = iden + 1 END SUB -SUB idenewsf (sf AS STRING) +FUNCTION ideinputbox$(title$, caption$, initialvalue$, validinput$, boxwidth, maxlength) '-------- generic dialog box header -------- @@ -7377,7 +7378,143 @@ SUB idenewsf (sf AS STRING) '-------- init -------- - 'built initial name if word selected + i = 0 + + idepar p, boxwidth, 5, title$ + + i = i + 1 + PrevFocus = 1 + o(i).typ = 1 + o(i).y = 2 + o(i).nam = idenewtxt(caption$) + o(i).txt = idenewtxt(initialvalue$) + IF LEN(initialvalue$) > 0 THEN o(i).issel = -1 + o(i).sx1 = 0 + o(i).v1 = LEN(initialvalue$) + + i = i + 1 + o(i).typ = 3 + o(i).y = 5 + o(i).txt = idenewtxt("#OK" + sep + "#Cancel") + o(i).dft = 1 + '-------- end of init -------- + + '-------- generic init -------- + FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects + '-------- end of generic init -------- + + DO 'main loop + + + '-------- generic display dialog box & objects -------- + idedrawpar p + f = 1: cx = 0: cy = 0 + FOR i = 1 TO 100 + IF o(i).typ THEN + + 'prepare object + o(i).foc = focus - f 'focus offset + o(i).cx = 0: o(i).cy = 0 + idedrawobj o(i), f 'display object + IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy + END IF + NEXT i + lastfocus = f - 1 + '-------- end of generic display dialog box & objects -------- + + '-------- custom display changes -------- + '-------- end of custom display changes -------- + + 'update visual page and cursor position + PCOPY 1, 0 + IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0 + + '-------- read input -------- + change = 0 + DO + GetInput + IF mWHEEL THEN change = 1 + IF KB THEN change = 1 + IF mCLICK THEN mousedown = 1: change = 1 + IF mRELEASE THEN mouseup = 1: change = 1 + IF mB THEN change = 1 + alt = KALT: IF alt <> oldalt THEN change = 1 + oldalt = alt + _LIMIT 100 + LOOP UNTIL change + IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0 + 'convert "alt+letter" scancode to letter's ASCII character + altletter$ = "" + IF alt AND NOT KCTRL THEN + IF LEN(K$) = 1 THEN + k = ASC(UCASE$(K$)) + IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) + END IF + END IF + SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0 + '-------- end of read input -------- + + '-------- generic input response -------- + info = 0 + IF K$ = "" THEN K$ = CHR$(255) + IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1 + IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = "" + IF focus < 1 THEN focus = lastfocus + IF focus > lastfocus THEN focus = 1 + f = 1 + FOR i = 1 TO 100 + t = o(i).typ + IF t THEN + focusoffset = focus - f + ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL + END IF + NEXT + '-------- end of generic input response -------- + + 'specific post controls + IF focus <> PrevFocus THEN + 'Always start with TextBox values selected upon getting focus + PrevFocus = focus + IF focus = 1 THEN + o(focus).v1 = LEN(idetxt(o(focus).txt)) + IF o(focus).v1 > 0 THEN o(focus).issel = -1 + o(focus).sx1 = 0 + END IF + END IF + + IF LEN(validinput$) THEN + a$ = idetxt(o(1).txt) + tempA$ = "" + FOR i = 1 TO LEN(a$) + IF INSTR(validinput$, MID$(a$, i, 1)) > 0 THEN + tempA$ = tempA$ + MID$(a$, i, 1) + END IF + NEXT + idetxt(o(1).txt) = tempA$ + END IF + + IF maxlength THEN + idetxt(o(1).txt) = LEFT$(idetxt(o(1).txt), maxlength) + END IF + + IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN + EXIT FUNCTION + END IF + + IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN + ideinputbox$ = idetxt(o(1).txt) + EXIT FUNCTION + END IF + 'end of custom controls + + mousedown = 0 + mouseup = 0 + LOOP + +END FUNCTION + +SUB idenewsf (sf AS STRING) + 'build initial name if word selected IF ideselect THEN IF ideselecty1 = idecy THEN 'single line selected a$ = idegetline(idecy) @@ -7390,282 +7527,34 @@ SUB idenewsf (sf AS STRING) END IF END IF - i = 0 - - idepar p, 60, 5, "New " + sf$ - - i = i + 1 - PrevFocus = 1 - o(i).typ = 1 - o(i).y = 2 - o(i).nam = idenewtxt("#Name") - o(i).txt = idenewtxt(a2$) - IF LEN(a2$) > 0 THEN o(i).issel = -1 - o(i).sx1 = 0 - o(i).v1 = LEN(a2$) - - i = i + 1 - o(i).typ = 3 - o(i).y = 5 - o(i).txt = idenewtxt("#OK" + sep + "#Cancel") - o(i).dft = 1 - '-------- end of init -------- - - '-------- generic init -------- - FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects - '-------- end of generic init -------- - - DO 'main loop - - - '-------- generic display dialog box & objects -------- - idedrawpar p - f = 1: cx = 0: cy = 0 - FOR i = 1 TO 100 - IF o(i).typ THEN - - 'prepare object - o(i).foc = focus - f 'focus offset - o(i).cx = 0: o(i).cy = 0 - idedrawobj o(i), f 'display object - IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy - END IF - NEXT i - lastfocus = f - 1 - '-------- end of generic display dialog box & objects -------- - - '-------- custom display changes -------- - '-------- end of custom display changes -------- - - 'update visual page and cursor position - PCOPY 1, 0 - IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0 - - '-------- read input -------- - change = 0 - DO - GetInput - IF mWHEEL THEN change = 1 - IF KB THEN change = 1 - IF mCLICK THEN mousedown = 1: change = 1 - IF mRELEASE THEN mouseup = 1: change = 1 - IF mB THEN change = 1 - alt = KALT: IF alt <> oldalt THEN change = 1 - oldalt = alt - _LIMIT 100 - LOOP UNTIL change - IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0 - 'convert "alt+letter" scancode to letter's ASCII character - altletter$ = "" - IF alt AND NOT KCTRL THEN - IF LEN(K$) = 1 THEN - k = ASC(UCASE$(K$)) - IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) - END IF - END IF - SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0 - '-------- end of read input -------- - - '-------- generic input response -------- - info = 0 - IF K$ = "" THEN K$ = CHR$(255) - IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1 - IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = "" - IF focus < 1 THEN focus = lastfocus - IF focus > lastfocus THEN focus = 1 - f = 1 - FOR i = 1 TO 100 - t = o(i).typ - IF t THEN - focusoffset = focus - f - ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL - END IF - NEXT - '-------- end of generic input response -------- - - 'specific post controls - IF focus <> PrevFocus THEN - 'Always start with TextBox values selected upon getting focus - PrevFocus = focus - IF focus = 1 THEN - o(focus).v1 = LEN(idetxt(o(focus).txt)) - IF o(focus).v1 > 0 THEN o(focus).issel = -1 - o(focus).sx1 = 0 - END IF - END IF - - IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN - EXIT SUB - END IF - - IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN - y = iden - y = y + 1: idesetline y, "" - y = y + 1: idesetline y, sf$ + " " + idetxt(o(1).txt) - idesy = y - y = y + 1: idesetline y, "" - idecy = y - y = y + 1: idesetline y, "END " + sf$ - idecx = 1: idesx = 1 - idechangemade = 1 - EXIT SUB - END IF - - 'end of custom controls - - mousedown = 0 - mouseup = 0 - LOOP - - + newSF$ = ideinputbox$("New " + sf$, "#Name", a2$, "", 60, 40) + IF LEN(newSF$) THEN + y = iden + y = y + 1: idesetline y, "" + y = y + 1: idesetline y, sf$ + " " + newSF$ + idesy = y + y = y + 1: idesetline y, "" + idecy = y + y = y + 1: idesetline y, "END " + sf$ + idecx = 1: idesx = 1 + idechangemade = 1 + END IF END SUB FUNCTION idenewfolder$(thispath$) + newfolder$ = ideinputbox$("New Folder", "#Name", "", "", 60, 0) - - '-------- generic dialog box header -------- - PCOPY 3, 0 - PCOPY 0, 2 - PCOPY 0, 1 - SCREEN , , 1, 0 - focus = 1 - DIM p AS idedbptype - DIM o(1 TO 100) AS idedbotype - DIM sep AS STRING * 1 - sep = CHR$(0) - '-------- end of generic dialog box header -------- - - '-------- init -------- - - i = 0 - - idepar p, 60, 5, "New Folder" - - i = i + 1 - PrevFocus = 1 - o(i).typ = 1 - o(i).y = 2 - o(i).nam = idenewtxt("#Name") - o(i).txt = idenewtxt(a2$) - IF LEN(a2$) > 0 THEN o(i).issel = -1 - o(i).sx1 = 0 - o(i).v1 = LEN(a2$) - - i = i + 1 - o(i).typ = 3 - o(i).y = 5 - o(i).txt = idenewtxt("#OK" + sep + "#Cancel") - o(i).dft = 1 - '-------- end of init -------- - - '-------- generic init -------- - FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects - '-------- end of generic init -------- - - DO 'main loop - - - '-------- generic display dialog box & objects -------- - idedrawpar p - f = 1: cx = 0: cy = 0 - FOR i = 1 TO 100 - IF o(i).typ THEN - - 'prepare object - o(i).foc = focus - f 'focus offset - o(i).cx = 0: o(i).cy = 0 - idedrawobj o(i), f 'display object - IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy - END IF - NEXT i - lastfocus = f - 1 - '-------- end of generic display dialog box & objects -------- - - '-------- custom display changes -------- - '-------- end of custom display changes -------- - - 'update visual page and cursor position - PCOPY 1, 0 - IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0 - - '-------- read input -------- - change = 0 - DO - GetInput - IF mWHEEL THEN change = 1 - IF KB THEN change = 1 - IF mCLICK THEN mousedown = 1: change = 1 - IF mRELEASE THEN mouseup = 1: change = 1 - IF mB THEN change = 1 - alt = KALT: IF alt <> oldalt THEN change = 1 - oldalt = alt - _LIMIT 100 - LOOP UNTIL change - IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0 - 'convert "alt+letter" scancode to letter's ASCII character - altletter$ = "" - IF alt AND NOT KCTRL THEN - IF LEN(K$) = 1 THEN - k = ASC(UCASE$(K$)) - IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) - END IF - END IF - SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0 - '-------- end of read input -------- - - '-------- generic input response -------- - info = 0 - IF K$ = "" THEN K$ = CHR$(255) - IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1 - IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = "" - IF focus < 1 THEN focus = lastfocus - IF focus > lastfocus THEN focus = 1 - f = 1 - FOR i = 1 TO 100 - t = o(i).typ - IF t THEN - focusoffset = focus - f - ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL - END IF - NEXT - '-------- end of generic input response -------- - - 'specific post controls - IF focus <> PrevFocus THEN - 'Always start with TextBox values selected upon getting focus - PrevFocus = focus - IF focus = 1 THEN - o(focus).v1 = LEN(idetxt(o(focus).txt)) - IF o(focus).v1 > 0 THEN o(focus).issel = -1 - o(focus).sx1 = 0 - END IF - END IF - - IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN + IF LEN(newfolder$) THEN + IF _DIREXISTS(thispath$ + idepathsep$ + newfolder$) THEN + idenewfolder$ = newfolder$ EXIT SUB END IF - - IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN - IF _DIREXISTS(thispath$ + idepathsep$ + idetxt(o(1).txt)) THEN - idenewfolder$ = idetxt(o(1).txt) - EXIT SUB - END IF - ideerror = 5 - MKDIR thispath$ + idepathsep$ + idetxt(o(1).txt) - ideerror = 1 - idenewfolder$ = idetxt(o(1).txt) - EXIT SUB - END IF - - 'end of custom controls - - mousedown = 0 - mouseup = 0 - LOOP - - - + ideerror = 5 + MKDIR thispath$ + idepathsep$ + newfolder$ + ideerror = 1 + idenewfolder$ = newfolder$ + END IF END SUB @@ -10760,298 +10649,18 @@ FUNCTION idebackupbox LOOP END FUNCTION - - - -FUNCTION idemodifycommandbox - '-------- generic dialog box header -------- - PCOPY 0, 2 - PCOPY 0, 1 - SCREEN , , 1, 0 - focus = 1 - DIM p AS idedbptype - DIM o(1 TO 100) AS idedbotype - DIM sep AS STRING * 1 - sep = CHR$(0) - '-------- end of generic dialog box header -------- - - '-------- init -------- - i = 0 - idepar p, 65, 5, "Modify COMMAND$" - - a2$ = ModifyCOMMAND$ - IF LEN(a2$) > 0 THEN a2$ = MID$(a2$, 2) - i = i + 1 - PrevFocus = 1 - o(i).typ = 1 - o(i).y = 2 - o(i).nam = idenewtxt("#Enter text for COMMAND$") - o(i).txt = idenewtxt(a2$) - o(i).v1 = LEN(a2$) - IF o(i).v1 > 0 THEN - o(i).issel = -1 - o(i).sx1 = 0 - END IF - - i = i + 1 - o(i).typ = 3 - o(i).y = 5 - o(i).txt = idenewtxt("#OK" + sep + "#Cancel") - o(i).dft = 1 - '-------- end of init -------- - - '-------- generic init -------- - FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects - '-------- end of generic init -------- - - DO 'main loop - - - '-------- generic display dialog box & objects -------- - idedrawpar p - f = 1: cx = 0: cy = 0 - FOR i = 1 TO 100 - IF o(i).typ THEN - - 'prepare object - o(i).foc = focus - f 'focus offset - o(i).cx = 0: o(i).cy = 0 - idedrawobj o(i), f 'display object - IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy - END IF - NEXT i - lastfocus = f - 1 - '-------- end of generic display dialog box & objects -------- - - '-------- custom display changes -------- - '-------- end of custom display changes -------- - - 'update visual page and cursor position - PCOPY 1, 0 - IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0 - - '-------- read input -------- - change = 0 - DO - GetInput - IF mWHEEL THEN change = 1 - IF KB THEN change = 1 - IF mCLICK THEN mousedown = 1: change = 1 - IF mRELEASE THEN mouseup = 1: change = 1 - IF mB THEN change = 1 - alt = KALT: IF alt <> oldalt THEN change = 1 - oldalt = alt - _LIMIT 100 - LOOP UNTIL change - IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0 - 'convert "alt+letter" scancode to letter's ASCII character - altletter$ = "" - IF alt AND NOT KCTRL THEN - IF LEN(K$) = 1 THEN - k = ASC(UCASE$(K$)) - IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) - END IF - END IF - SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0 - '-------- end of read input -------- - - '-------- generic input response -------- - info = 0 - IF K$ = "" THEN K$ = CHR$(255) - IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1 - IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = "" - IF focus < 1 THEN focus = lastfocus - IF focus > lastfocus THEN focus = 1 - f = 1 - FOR i = 1 TO 100 - t = o(i).typ - IF t THEN - focusoffset = focus - f - ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL - END IF - NEXT - '-------- end of generic input response -------- - - 'specific post controls - IF focus <> PrevFocus THEN - 'Always start with TextBox values selected upon getting focus - PrevFocus = focus - IF focus = 1 THEN - o(focus).v1 = LEN(idetxt(o(focus).txt)) - IF o(focus).v1 > 0 THEN o(focus).issel = -1 - o(focus).sx1 = 0 - END IF - END IF - - IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN EXIT FUNCTION - - IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN - ModifyCOMMAND$ = " " + idetxt(o(1).txt) - IF LTRIM$(RTRIM$(ModifyCOMMAND$)) = "" THEN ModifyCOMMAND$ = "" - EXIT FUNCTION - END IF - - 'end of custom controls - - mousedown = 0 - mouseup = 0 - LOOP - idemodifycommandbox = 0 -END FUNCTION - FUNCTION idegotobox - '-------- generic dialog box header -------- - PCOPY 0, 2 - PCOPY 0, 1 - SCREEN , , 1, 0 - focus = 1 - DIM p AS idedbptype - DIM o(1 TO 100) AS idedbotype - DIM sep AS STRING * 1 - sep = CHR$(0) - '-------- end of generic dialog box header -------- - - '-------- init -------- - i = 0 - idepar p, 30, 5, "Go To Line" - IF idegotobox_LastLineNum > 0 THEN a2$ = str2$(idegotobox_LastLineNum) ELSE a2$ = "" - i = i + 1 - PrevFocus = 1 - o(i).typ = 1 - o(i).y = 2 - o(i).nam = idenewtxt("#Line") - o(i).txt = idenewtxt(a2$) - o(i).v1 = LEN(a2$) - IF o(i).v1 > 0 THEN - o(i).issel = -1 - o(i).sx1 = 0 - END IF + v$ = ideinputbox$("Go To Line", "#Line", a2$, "0123456789", 30, 8) + IF v$ = "" THEN EXIT FUNCTION - i = i + 1 - o(i).typ = 3 - o(i).y = 5 - o(i).txt = idenewtxt("#OK" + sep + "#Cancel") - o(i).dft = 1 - '-------- end of init -------- - - '-------- generic init -------- - FOR i = 1 TO 100: o(i).par = p: NEXT 'set parent info of objects - '-------- end of generic init -------- - - DO 'main loop - - - '-------- generic display dialog box & objects -------- - idedrawpar p - f = 1: cx = 0: cy = 0 - FOR i = 1 TO 100 - IF o(i).typ THEN - - 'prepare object - o(i).foc = focus - f 'focus offset - o(i).cx = 0: o(i).cy = 0 - idedrawobj o(i), f 'display object - IF o(i).cx THEN cx = o(i).cx: cy = o(i).cy - END IF - NEXT i - lastfocus = f - 1 - '-------- end of generic display dialog box & objects -------- - - '-------- custom display changes -------- - '-------- end of custom display changes -------- - - 'update visual page and cursor position - PCOPY 1, 0 - IF cx THEN SCREEN , , 0, 0: LOCATE cy, cx, 1: SCREEN , , 1, 0 - - '-------- read input -------- - change = 0 - DO - GetInput - IF mWHEEL THEN change = 1 - IF KB THEN change = 1 - IF mCLICK THEN mousedown = 1: change = 1 - IF mRELEASE THEN mouseup = 1: change = 1 - IF mB THEN change = 1 - alt = KALT: IF alt <> oldalt THEN change = 1 - oldalt = alt - _LIMIT 100 - LOOP UNTIL change - IF alt AND NOT KCTRL THEN idehl = 1 ELSE idehl = 0 - 'convert "alt+letter" scancode to letter's ASCII character - altletter$ = "" - IF alt AND NOT KCTRL THEN - IF LEN(K$) = 1 THEN - k = ASC(UCASE$(K$)) - IF k >= 65 AND k <= 90 THEN altletter$ = CHR$(k) - END IF - END IF - SCREEN , , 0, 0: LOCATE , , 0: SCREEN , , 1, 0 - '-------- end of read input -------- - - '-------- generic input response -------- - info = 0 - IF K$ = "" THEN K$ = CHR$(255) - IF KSHIFT = 0 AND K$ = CHR$(9) THEN focus = focus + 1 - IF (KSHIFT AND K$ = CHR$(9)) OR (INSTR(_OS$, "MAC") AND K$ = CHR$(25)) THEN focus = focus - 1: K$ = "" - IF focus < 1 THEN focus = lastfocus - IF focus > lastfocus THEN focus = 1 - f = 1 - FOR i = 1 TO 100 - t = o(i).typ - IF t THEN - focusoffset = focus - f - ideobjupdate o(i), focus, f, focusoffset, K$, altletter$, mB, mousedown, mouseup, mX, mY, info, mWHEEL - END IF - NEXT - '-------- end of generic input response -------- - - 'specific post controls - IF focus <> PrevFocus THEN - 'Always start with TextBox values selected upon getting focus - PrevFocus = focus - IF focus = 1 THEN - o(focus).v1 = LEN(idetxt(o(focus).txt)) - IF o(focus).v1 > 0 THEN o(focus).issel = -1 - o(focus).sx1 = 0 - END IF - END IF - - a$ = idetxt(o(1).txt) - IF LEN(a$) > 8 THEN a$ = LEFT$(a$, 8) '8 character limit - FOR i = 1 TO LEN(a$) - a = ASC(a$, i) - IF i = 2 AND ASC(a$, 1) = 48 THEN a$ = "0": EXIT FOR - IF a < 48 OR a > 57 THEN a$ = LEFT$(a$, i - 1): EXIT FOR - NEXT - IF focus <> 1 THEN - a = VAL(a$) - IF a < 1 THEN a$ = "1" - END IF - idetxt(o(1).txt) = a$ - - IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN EXIT FUNCTION - - IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) THEN - v$ = idetxt(o(1).txt) - v& = VAL(v$) - IF v& < 1 THEN v& = 1 - IF v& > iden THEN v& = iden - idegotobox_LastLineNum = v& - AddQuickNavHistory idecy - idecy = v& - ideselect = 0 - EXIT FUNCTION - END IF - - 'end of custom controls - - mousedown = 0 - mouseup = 0 - LOOP - - idegotobox = 0 + v& = VAL(v$) + IF v& < 1 THEN v& = 1 + IF v& > iden THEN v& = iden + idegotobox_LastLineNum = v& + AddQuickNavHistory idecy + idecy = v& + ideselect = 0 END FUNCTION From bae61981f017c393c18a6bad9854ef95aceb83e6 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 01:44:30 -0300 Subject: [PATCH 2/9] One less dialog when trying to load missing "Recent files". --- source/ide/ide_methods.bas | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index a1c21928a..198603b9b 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -148,6 +148,7 @@ FUNCTION ide2 (ignore) IF ideerror = 3 THEN errorat$ = "File access error": CLOSE #150 IF ideerror = 4 THEN errorat$ = "Path not found" IF ideerror = 5 THEN errorat$ = "Cannot create folder" + IF ideerror = 6 THEN errorat$ = "Cannot save file" IF ideerror = -1 THEN GOTO errorReportDone 'fail quietly - like ON ERROR RESUME NEXT qberrorcode = ERR @@ -160,6 +161,16 @@ FUNCTION ide2 (ignore) IF (ideerror > 1) THEN 'Don't show too much detail if user just tried loading an invalid file ideerrormessageTITLE$ = ideerrormessageTITLE$ + " (" + str2$(_ERRORLINE) + "-" + str2$(_INCLERRORLINE) + ")" + IF AttemptToLoadRecent = -1 THEN + 'Offer to cleanup recent file list, removing invalid entries + PCOPY 2, 0 + result = idemessagebox(ideerrormessageTITLE$, errorat$ + "." + CHR$(10) + CHR$(10) + "Remove broken links from recent files?", "#Yes;#No") + IF result = 1 THEN + GOSUB CleanUpRecentList + END IF + PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt + GOTO errorReportDone + END IF ELSE 'a more serious error; let's report something that'll help bug reporting inclerrorline = _INCLERRORLINE @@ -177,16 +188,6 @@ FUNCTION ide2 (ignore) errorReportDone: END IF - IF (ideerror > 1) AND (AttemptToLoadRecent = -1) THEN - 'Offer to cleanup recent file list, removing invalid entries - PCOPY 2, 0 - r$ = ideclearhistory$("INVALID") - IF r$ = "Y" THEN - GOSUB CleanUpRecentList - END IF - PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt - END IF - ideerror = 1 'unknown IDE error AttemptToLoadRecent = 0 @@ -7963,14 +7964,15 @@ FUNCTION ideclearhistory$ (WhichHistory$) SELECT CASE WhichHistory$ CASE "SEARCH": t$ = "Clear search history": m$ = "This cannot be undone. Proceed?" CASE "FILES": t$ = "Clear recent files": m$ = "This cannot be undone. Proceed?" - CASE "INVALID": t$ = "Recent files": m$ = "Remove broken links from recent files?" END SELECT result = idemessagebox(t$, m$, "#Yes;#No") IF result = 1 THEN ideclearhistory$ = "Y" ELSE ideclearhistory$ = "N" END FUNCTION SUB idesave (f$) + ideerror = 6 OPEN f$ FOR OUTPUT AS #151 + ideerror = 1 FOR i = 1 TO iden a$ = idegetline(i) PRINT #151, a$ From aef35c96e1e1d8251e9583cf93d73b9e65e44c8c Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 02:07:22 -0300 Subject: [PATCH 3/9] Makes idegotobox a SUB. --- source/ide/ide_methods.bas | 11 +++++------ source/qb64.bas | 2 -- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index 198603b9b..b09cbff07 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -3136,7 +3136,7 @@ FUNCTION ide2 (ignore) idecy = idefocusline ideselect = 0 ELSE - retval = idegotobox + idegotobox 'retval is ignored PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt END IF @@ -4958,8 +4958,7 @@ FUNCTION ide2 (ignore) IF menu$(m, s) = "#Go To Line... Ctrl+G" THEN PCOPY 2, 0 - retval = idegotobox - 'retval is ignored + idegotobox PCOPY 3, 0: SCREEN , , 3, 0: idewait4mous: idewait4alt GOTO ideloop END IF @@ -10651,10 +10650,10 @@ FUNCTION idebackupbox LOOP END FUNCTION -FUNCTION idegotobox +SUB idegotobox IF idegotobox_LastLineNum > 0 THEN a2$ = str2$(idegotobox_LastLineNum) ELSE a2$ = "" v$ = ideinputbox$("Go To Line", "#Line", a2$, "0123456789", 30, 8) - IF v$ = "" THEN EXIT FUNCTION + IF v$ = "" THEN EXIT SUB v& = VAL(v$) IF v& < 1 THEN v& = 1 @@ -10663,7 +10662,7 @@ FUNCTION idegotobox AddQuickNavHistory idecy idecy = v& ideselect = 0 -END FUNCTION +END SUB diff --git a/source/qb64.bas b/source/qb64.bas index d417041ab..75c5ddcb9 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -15,7 +15,6 @@ $SCREENHIDE '$INCLUDE:'global\constants.bas' '$INCLUDE:'subs_functions\extensions\opengl\opengl_global.bas' -'INCLUDE:'qb_framework\qb_framework_global.bas' DEFLNG A-Z '-------- Optional IDE Component (1/2) -------- @@ -25201,7 +25200,6 @@ END SUB '$INCLUDE:'subs_functions\extensions\opengl\opengl_methods.bas' -'INCLUDE:'qb_framework\qb_framework_methods.bas' DEFLNG A-Z '-------- Optional IDE Component (2/2) -------- From 1e11ff17b631f3e8219cd703b88af0e8b98b2a15 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 10:57:58 -0300 Subject: [PATCH 4/9] Begins changing warning system to consider includes. --- source/qb64.bas | 35 ++++++++++++++++++++++++----------- 1 file changed, 24 insertions(+), 11 deletions(-) diff --git a/source/qb64.bas b/source/qb64.bas index 75c5ddcb9..73913d379 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -25162,7 +25162,7 @@ SUB manageVariableList (name$, __cname$, action AS _BYTE) s$ = CHR$(4) + MKI$(LEN(cname$)) + cname$ + CHR$(5) IF INSTR(usedVariableList$, s$) = 0 THEN ASC(s$, 1) = 3 - usedVariableList$ = usedVariableList$ + CHR$(1) + MKL$(linenumber) + CHR$(2) + usedVariableList$ = usedVariableList$ + CHR$(1) + MKL$(linenumber) + MKL$(inclevel) + MKL$(inclinenumber(inclevel)) + incname$(inclevel) + CHR$(2) usedVariableList$ = usedVariableList$ + "VAR:" + s$ + name$ + CHR$(10) totalUnusedVariables = totalUnusedVariables + 1 'warning$(1) = warning$(1) + "Adding " + cname$ + " at line" + STR$(linenumber) + CHR$(10) @@ -25180,19 +25180,32 @@ END SUB SUB addWarning (lineNumber AS LONG, text$) IF NOT IgnoreWarnings THEN - IF lineNumber > 0 THEN - totalWarnings = totalWarnings + 1 - ELSE - IF lastWarningHeader = text$ THEN - EXIT SUB + IF idemode = 0 THEN + PRINT + IF lineNumber = 0 THEN + PRINT "Warning: "; text$; ELSE - lastWarningHeader = text$ + IF VerboseMode THEN + PRINT "; "; text$; " (line"; STR$(lineNumber); ")" + ELSE + PRINT " (line"; STR$(lineNumber); ")" + END IF + END IF + ELSE + IF lineNumber > 0 THEN + totalWarnings = totalWarnings + 1 + ELSE + IF lastWarningHeader = text$ THEN + EXIT SUB + ELSE + lastWarningHeader = text$ + END IF END IF - END IF - warningListItems = warningListItems + 1 - IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) - warning$(warningListItems) = MKL$(lineNumber) + text$ + warningListItems = warningListItems + 1 + IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) + warning$(warningListItems) = MKL$(lineNumber) + MKL$(inclevel) + MKL$(inclinenumber(inclevel)) + incname$(inclevel) + CHR$(2) + text$ + END IF END IF END SUB From c9ac352d87a87c8aaecb17319a523a259a48bb77 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 17:51:40 -0300 Subject: [PATCH 5/9] Improves warning system to add $include info. --- source/ide/ide_methods.bas | 23 +++-- source/qb64.bas | 167 +++++++++++++++++++------------------ 2 files changed, 104 insertions(+), 86 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index b09cbff07..a04d22b87 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -2828,6 +2828,8 @@ FUNCTION ide2 (ignore) p$ = QuotedFilename$(COMMAND$(0)) + " " + QuotedFilename$(f$) IF errorLineInInclude > 0 AND idefocusline = idecy THEN p$ = p$ + " -l:" + str2$(errorLineInInclude) + ELSEIF warningInIncludeLine > 0 AND warningInInclude = idecy THEN + p$ = p$ + " -l:" + str2$(warningInIncludeLine) END IF SHELL p$ @@ -9285,18 +9287,25 @@ FUNCTION idewarningbox '-------- init -------- DIM warningLines(1 TO warningListItems) AS LONG + DIM warningIncLines(1 TO warningListItems) AS LONG + DIM warningIncFiles(1 TO warningListItems) AS STRING FOR x = 1 TO warningListItems warningLines(x) = CVL(LEFT$(warning$(x), 4)) IF warningLines(x) = 0 THEN - l$ = l$ + MID$(warning$(x), 5) + l$ = l$ + MID$(warning$(x), INSTR(warning$(x), CHR$(2)) + 1) IF x > 1 THEN ASC(l$, treeConnection) = 192 ELSE - l2$ = "line" + STR$(warningLines(x)) - l3$ = SPACE$(maxLineNumberLength + 4) - RSET l3$ = l2$ + warningIncLevel = CVL(MID$(warning$(x), 5, 4)) + IF warningIncLevel > 0 THEN + warningIncLines(x) = CVL(MID$(warning$(x), 9, 4)) + warningIncFiles(x) = MID$(warning$(x), 13, INSTR(warning$(x), CHR$(2)) - 13) + l3$ = "line" + STR$(warningIncLines(x)) + " in '" + warningIncFiles(x) + "'" + ELSE + l3$ = "line" + STR$(warningLines(x)) + END IF treeConnection = LEN(l$) + 1 - l$ = l$ + CHR$(195) + CHR$(196) + l3$ + ": " + MID$(warning$(x), 5) + l$ = l$ + CHR$(195) + CHR$(196) + l3$ + ": " + MID$(warning$(x), INSTR(warning$(x), CHR$(2)) + 1) END IF IF x < warningListItems THEN l$ = l$ + sep NEXT @@ -9415,6 +9424,10 @@ FUNCTION idewarningbox idegotobox_LastLineNum = warningLines(y) AddQuickNavHistory idecy idecy = idegotobox_LastLineNum + IF warningIncLines(y) > 0 THEN + warningInInclude = idecy + warningInIncludeLine = warningIncLines(y) + END IF ideselect = 0 EXIT FUNCTION END IF diff --git a/source/qb64.bas b/source/qb64.bas index 3de801f4e..3795159d9 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -92,7 +92,18 @@ _TITLE WindowTitle DIM SHARED ConsoleMode, No_C_Compile_Mode, NoIDEMode DIM SHARED VerboseMode AS _BYTE, QuietMode AS _BYTE, CMDLineFile AS STRING -DIM SHARED totalUnusedVariables AS LONG, usedVariableList$, bypassNextVariable AS _BYTE +TYPE usedVarList + used AS _BYTE + linenumber AS LONG + includeLevel AS LONG + includedLine AS LONG + includedFile AS STRING + cname AS STRING + name AS STRING +END TYPE + +REDIM SHARED usedVariableList(1000) AS usedVarList, totalVariablesCreated AS LONG +DIM SHARED totalUnusedVariables AS LONG, bypassNextVariable AS _BYTE DIM SHARED totalWarnings AS LONG, warningListItems AS LONG, lastWarningHeader AS STRING DIM SHARED duplicateConstWarning AS _BYTE DIM SHARED emptySCWarning AS _BYTE @@ -328,6 +339,7 @@ DIM SHARED optionexplicit AS _BYTE DIM SHARED optionexplicitarray AS _BYTE DIM SHARED optionexplicit_cmd AS _BYTE DIM SHARED ideStartAtLine AS LONG, errorLineInInclude AS LONG +DIM SHARED warningInInclude AS LONG, warningInIncludeLine AS LONG DIM SHARED outputfile_cmd$ DIM SHARED compilelog$ @@ -1401,8 +1413,8 @@ subfunc = "" SelectCaseCounter = 0 ExecCounter = 0 UserDefineCount = 6 -usedVariableList$ = "" totalUnusedVariables = 0 +totalVariablesCreated = 0 totalWarnings = 0 duplicateConstWarning = 0 emptySCWarning = 0 @@ -2123,22 +2135,22 @@ DO 'just issue a warning instead of an error issueWarning = 0 IF t AND ISSTRING THEN - IF conststring(hashresref) = e$ THEN issueWarning = -1 + IF conststring(hashresref) = e$ THEN issueWarning = -1: thisconstval$ = e$ ELSE IF t AND ISFLOAT THEN - IF constfloat(hashresref) = constval## THEN issueWarning = -1 + IF constfloat(hashresref) = constval## THEN issueWarning = -1: thisconstval$ = STR$(constval##) ELSE IF t AND ISUNSIGNED THEN - IF constuinteger(hashresref) = constval~&& THEN issueWarning = -1 + IF constuinteger(hashresref) = constval~&& THEN issueWarning = -1: thisconstval$ = STR$(constval~&&) ELSE - IF constinteger(hashresref) = constval&& THEN issueWarning = -1 + IF constinteger(hashresref) = constval&& THEN issueWarning = -1: thisconstval$ = STR$(constval&&) END IF END IF END IF IF issueWarning THEN IF NOT IgnoreWarnings THEN - addWarning 0, "Constant already defined (same value):" - addWarning linenumber, n$ + addWarning 0, 0, 0, "", "Constant already defined (same value):" + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), n$ + " =" + thisconstval$ IF idemode = 0 THEN IF duplicateConstWarning = 0 THEN PRINT: PRINT "Warning: duplicate constant definition"; IF VerboseMode THEN @@ -5859,8 +5871,8 @@ DO IF SelectCaseCounter > 0 AND SelectCaseHasCaseBlock(SelectCaseCounter) = 0 THEN 'warn user of empty SELECT CASE block IF NOT IgnoreWarnings THEN - addWarning 0, "Empty SELECT CASE block:" - addWarning linenumber, "END SELECT" + addWarning 0, 0, 0, "", "Empty SELECT CASE block:" + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "END SELECT" IF idemode = 0 THEN IF emptySCWarning = 0 THEN PRINT: PRINT "Warning: Empty SELECT CASE block"; IF VerboseMode THEN @@ -11508,48 +11520,33 @@ IF NOT IgnoreWarnings THEN IF totalUnusedVariables > 1 THEN PRINT "s"; IF VerboseMode THEN PRINT ":" - findItem = 0 - DO - s$ = CHR$(2) + "VAR:" + CHR$(3) - findItem = INSTR(findItem + 1, usedVariableList$, s$) - IF findItem = 0 THEN EXIT DO - whichLine = CVL(MID$(usedVariableList$, findItem - 4, 4)) - varNameLen = CVI(MID$(usedVariableList$, findItem + 6, 2)) - internalVarName$ = MID$(usedVariableList$, findItem + 8, varNameLen) - findLF = INSTR(findItem + 9 + varNameLen, usedVariableList$, CHR$(10)) - varname$ = MID$(usedVariableList$, findItem + 9 + varNameLen, findLF - (findItem + 9 + varNameLen)) - PRINT SPACE$(4); varname$; " ("; internalVarName$; ", line"; STR$(whichLine); ")" - LOOP + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + PRINT SPACE$(4); usedVariableList(i).name; " ("; usedVariableList(i).cname; ", "; + IF usedVariableList(i).includeLevel > 0 THEN + PRINT "line"; STR$(usedVariableList(i).includedLine); " in file '"; usedVariableList(i).includedFile; "')" + ELSE + PRINT "line"; STR$(whichLine); ")" + END IF + END IF + NEXT ELSE PRINT END IF ELSE - findItem = 0 maxVarNameLen = 0 - DO - s$ = CHR$(2) + "VAR:" + CHR$(3) - findItem = INSTR(findItem + 1, usedVariableList$, s$) - IF findItem = 0 THEN EXIT DO - varNameLen = CVI(MID$(usedVariableList$, findItem + 6, 2)) - internalVarName$ = MID$(usedVariableList$, findItem + 8, varNameLen) - findLF = INSTR(findItem + 9 + varNameLen, usedVariableList$, CHR$(10)) - varname$ = MID$(usedVariableList$, findItem + 9 + varNameLen, findLF - (findItem + 9 + varNameLen)) - IF LEN(varname$) > maxVarNameLen THEN maxVarNameLen = LEN(varname$) - LOOP + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + IF LEN(usedVariableList(i).name) > maxVarNameLen THEN maxVarNameLen = LEN(usedVariableList(i).name) + END IF + NEXT - findItem = 0 - addWarning 0, "Unused variables (" + LTRIM$(STR$(totalUnusedVariables)) + "):" - DO - s$ = CHR$(2) + "VAR:" + CHR$(3) - findItem = INSTR(findItem + 1, usedVariableList$, s$) - IF findItem = 0 THEN EXIT DO - whichLine = CVL(MID$(usedVariableList$, findItem - 4, 4)) - varNameLen = CVI(MID$(usedVariableList$, findItem + 6, 2)) - internalVarName$ = MID$(usedVariableList$, findItem + 8, varNameLen) - findLF = INSTR(findItem + 9 + varNameLen, usedVariableList$, CHR$(10)) - varname$ = MID$(usedVariableList$, findItem + 9 + varNameLen, findLF - (findItem + 9 + varNameLen)) - addWarning whichLine, varname$ + SPACE$((maxVarNameLen + 1) - LEN(varname$)) + " (" + internalVarName$ + ")" - LOOP + addWarning 0, 0, 0, "", "Unused variables (" + LTRIM$(STR$(totalUnusedVariables)) + "):" + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + addWarning usedVariableList(i).linenumber, usedVariableList(i).includeLevel, usedVariableList(i).includedLine, usedVariableList(i).includedFile, usedVariableList(i).name + SPACE$((maxVarNameLen + 1) - LEN(usedVariableList(i).name)) + " (" + usedVariableList(i).cname + ")" + END IF + NEXT END IF END IF END IF @@ -25150,7 +25147,7 @@ SUB dump_udts END SUB SUB manageVariableList (name$, __cname$, action AS _BYTE) - DIM findItem AS LONG, s$, cname$ + DIM findItem AS LONG, s$, cname$, i AS LONG cname$ = __cname$ findItem = INSTR(cname$, "[") @@ -25158,54 +25155,62 @@ SUB manageVariableList (name$, __cname$, action AS _BYTE) cname$ = LEFT$(cname$, findItem - 1) END IF + found = 0 + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).cname = cname$ THEN found = -1: EXIT FOR + NEXT + SELECT CASE action CASE 0 'add - s$ = CHR$(4) + MKI$(LEN(cname$)) + cname$ + CHR$(5) - IF INSTR(usedVariableList$, s$) = 0 THEN - ASC(s$, 1) = 3 - usedVariableList$ = usedVariableList$ + CHR$(1) + MKL$(linenumber) + MKL$(inclevel) + MKL$(inclinenumber(inclevel)) + incname$(inclevel) + CHR$(2) - usedVariableList$ = usedVariableList$ + "VAR:" + s$ + name$ + CHR$(10) + IF found = 0 THEN + IF i > UBOUND(usedVariableList) THEN + REDIM _PRESERVE usedVariableList(UBOUND(usedVariableList) + 999) AS usedVarList + END IF + usedVariableList(i).used = 0 + usedVariableList(i).linenumber = linenumber + usedVariableList(i).includeLevel = inclevel + IF inclevel > 0 THEN + usedVariableList(i).includedLine = inclinenumber(inclevel) + thisincname$ = getfilepath$(incname$(inclevel)) + thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) + usedVariableList(i).includedFile = thisincname$ + ELSE + usedVariableList(i).includedLine = 0 + usedVariableList(i).includedFile = "" + END IF + usedVariableList(i).cname = cname$ + usedVariableList(i).name = name$ totalUnusedVariables = totalUnusedVariables + 1 - 'warning$(1) = warning$(1) + "Adding " + cname$ + " at line" + STR$(linenumber) + CHR$(10) + totalVariablesCreated = totalVariablesCreated + 1 END IF - CASE ELSE 'find and remove - s$ = CHR$(3) + MKI$(LEN(cname$)) + cname$ + CHR$(5) - findItem = INSTR(usedVariableList$, s$) - IF findItem THEN - ASC(usedVariableList$, findItem) = 4 + CASE ELSE 'find and mark as used + IF found THEN + usedVariableList(i).used = -1 totalUnusedVariables = totalUnusedVariables - 1 END IF - 'warning$(1) = warning$(1) + "Action:" + STR$(action) + " Searching " + cname$ + " at line" + STR$(linenumber) + CHR$(10) END SELECT END SUB -SUB addWarning (lineNumber AS LONG, text$) +SUB addWarning (whichLineNumber AS LONG, includeLevel AS LONG, incLineNumber AS LONG, incFileName$, text$) IF NOT IgnoreWarnings THEN - IF idemode = 0 THEN - PRINT - IF lineNumber = 0 THEN - PRINT "Warning: "; text$; - ELSE - IF VerboseMode THEN - PRINT "; "; text$; " (line"; STR$(lineNumber); ")" - ELSE - PRINT " (line"; STR$(lineNumber); ")" - END IF - END IF + IF whichLineNumber > 0 THEN + totalWarnings = totalWarnings + 1 ELSE - IF lineNumber > 0 THEN - totalWarnings = totalWarnings + 1 + IF lastWarningHeader = text$ THEN + EXIT SUB ELSE - IF lastWarningHeader = text$ THEN - EXIT SUB - ELSE - lastWarningHeader = text$ - END IF + lastWarningHeader = text$ END IF + END IF - warningListItems = warningListItems + 1 - IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) - warning$(warningListItems) = MKL$(lineNumber) + MKL$(inclevel) + MKL$(inclinenumber(inclevel)) + incname$(inclevel) + CHR$(2) + text$ + warningListItems = warningListItems + 1 + IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) + IF includeLevel > 0 THEN + thisincname$ = getfilepath$(incFileName$) + thisincname$ = MID$(incFileName$, LEN(thisincname$) + 1) + warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(includeLevel) + MKL$(incLineNumber) + thisincname$ + CHR$(2) + text$ + ELSE + warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(0) + CHR$(2) + text$ END IF END IF END SUB From 9755992de9f77d67258618bb9146b873ea5afbf8 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 19:01:30 -0300 Subject: [PATCH 6/9] Adds colored output to verbose mode (-vc switch). --- source/qb64.bas | 119 ++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 105 insertions(+), 14 deletions(-) diff --git a/source/qb64.bas b/source/qb64.bas index 3795159d9..d92512c82 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -91,6 +91,7 @@ _TITLE WindowTitle DIM SHARED ConsoleMode, No_C_Compile_Mode, NoIDEMode DIM SHARED VerboseMode AS _BYTE, QuietMode AS _BYTE, CMDLineFile AS STRING +DIM SHARED ColorVerboseMode AS _BYTE TYPE usedVarList used AS _BYTE @@ -105,7 +106,7 @@ END TYPE REDIM SHARED usedVariableList(1000) AS usedVarList, totalVariablesCreated AS LONG DIM SHARED totalUnusedVariables AS LONG, bypassNextVariable AS _BYTE DIM SHARED totalWarnings AS LONG, warningListItems AS LONG, lastWarningHeader AS STRING -DIM SHARED duplicateConstWarning AS _BYTE +DIM SHARED duplicateConstWarning AS _BYTE, warningsissued AS _BYTE DIM SHARED emptySCWarning AS _BYTE DIM SHARED ExeIconSet AS LONG, qb64prefix$, qb64prefix_set DIM SHARED VersionInfoSet AS _BYTE @@ -1113,7 +1114,10 @@ GOTO sendcommand noide: -IF (qb64versionprinted = 0 OR ConsoleMode = 0) AND NOT QuietMode THEN qb64versionprinted = -1: PRINT "QB64 Compiler V" + Version$ +IF (qb64versionprinted = 0 OR ConsoleMode = 0) AND NOT QuietMode THEN + qb64versionprinted = -1 + PRINT "QB64 Compiler V" + Version$ +END IF IF CMDLineFile = "" THEN LINE INPUT ; "COMPILE (.bas)>", f$ @@ -2151,10 +2155,42 @@ DO IF NOT IgnoreWarnings THEN addWarning 0, 0, 0, "", "Constant already defined (same value):" addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), n$ + " =" + thisconstval$ - IF idemode = 0 THEN - IF duplicateConstWarning = 0 THEN PRINT: PRINT "Warning: duplicate constant definition"; + IF idemode = 0 AND NOT QuietMode THEN + IF ColorVerboseMode THEN COLOR 5 + IF duplicateConstWarning = 0 THEN PRINT: PRINT "Warning: "; + IF ColorVerboseMode THEN COLOR 7 + PRINT "duplicate constant definition"; IF VerboseMode THEN - PRINT ": '"; n$; "' (line"; STR$(linenumber); ")" + thisincname$ = getfilepath$(incname$(inclevel)) + thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) + IF inclevel = 0 THEN + IF ColorVerboseMode THEN COLOR 8 + PRINT ": '"; + IF ColorVerboseMode THEN COLOR 15 + PRINT n$; + IF ColorVerboseMode THEN COLOR 8 + PRINT "' (line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(linenumber); + IF ColorVerboseMode THEN COLOR 8 + PRINT ")" + ELSE + IF ColorVerboseMode THEN COLOR 8 + PRINT ": '"; + IF ColorVerboseMode THEN COLOR 15 + PRINT n$; + IF ColorVerboseMode THEN COLOR 8 + PRINT "' (line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(linenumber); + IF ColorVerboseMode THEN COLOR 8 + PRINT " in file '"; + IF ColorVerboseMode THEN COLOR 2 + PRINT thisincname$; + IF ColorVerboseMode THEN COLOR 8 + PRINT "')" + END IF + IF ColorVerboseMode THEN COLOR 7 ELSE IF duplicateConstWarning = 0 THEN duplicateConstWarning = -1 @@ -5873,10 +5909,38 @@ DO IF NOT IgnoreWarnings THEN addWarning 0, 0, 0, "", "Empty SELECT CASE block:" addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "END SELECT" - IF idemode = 0 THEN - IF emptySCWarning = 0 THEN PRINT: PRINT "Warning: Empty SELECT CASE block"; + IF idemode = 0 AND NOT QuietMode THEN + IF ColorVerboseMode THEN COLOR 5 + IF emptySCWarning = 0 THEN PRINT: PRINT "Warning: "; + IF ColorVerboseMode THEN COLOR 7 + PRINT "Empty SELECT CASE block"; IF VerboseMode THEN - PRINT ": 'END SELECT' (line"; STR$(linenumber); ")" + IF ColorVerboseMode THEN COLOR 8 + PRINT ": "; + IF ColorVerboseMode THEN COLOR 15 + PRINT "'END SELECT' "; + IF inclevel = 0 THEN + IF ColorVerboseMode THEN COLOR 8 + PRINT "(line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(linenumber); + IF ColorVerboseMode THEN COLOR 8 + PRINT ")" + ELSE + thisincname$ = getfilepath$(incname$(inclevel)) + thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) + IF ColorVerboseMode THEN COLOR 8 + PRINT "' (line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(linenumber); + IF ColorVerboseMode THEN COLOR 8 + PRINT " in file '"; + IF ColorVerboseMode THEN COLOR 2 + PRINT thisincname$; + IF ColorVerboseMode THEN COLOR 8 + PRINT "')" + END IF + IF ColorVerboseMode THEN COLOR 7 ELSE IF emptySCWarning = 0 THEN emptySCWarning = -1 @@ -11514,20 +11578,37 @@ END IF 'CLOSE #1 IF NOT IgnoreWarnings THEN IF totalUnusedVariables > 0 THEN - IF idemode = 0 THEN + IF idemode = 0 AND NOT QuietMode THEN PRINT - PRINT "Warning:"; STR$(totalUnusedVariables); " unused variable"; + IF ColorVerboseMode THEN COLOR 5 + PRINT "Warning:"; + IF ColorVerboseMode THEN COLOR 7 + PRINT STR$(totalUnusedVariables); " unused variable"; IF totalUnusedVariables > 1 THEN PRINT "s"; IF VerboseMode THEN PRINT ":" FOR i = 1 TO totalVariablesCreated IF usedVariableList(i).used = 0 THEN + IF ColorVerboseMode THEN COLOR 8 PRINT SPACE$(4); usedVariableList(i).name; " ("; usedVariableList(i).cname; ", "; IF usedVariableList(i).includeLevel > 0 THEN - PRINT "line"; STR$(usedVariableList(i).includedLine); " in file '"; usedVariableList(i).includedFile; "')" + PRINT "line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(usedVariableList(i).includedLine); + IF ColorVerboseMode THEN COLOR 8 + PRINT " in file '"; + IF ColorVerboseMode THEN COLOR 2 + PRINT usedVariableList(i).includedFile; + IF ColorVerboseMode THEN COLOR 8 + PRINT "')" ELSE - PRINT "line"; STR$(whichLine); ")" + PRINT "line"; + IF ColorVerboseMode THEN COLOR 15 + PRINT STR$(usedVariableList(i).linenumber); + IF ColorVerboseMode THEN COLOR 8 + PRINT ")" END IF + IF ColorVerboseMode THEN COLOR 7 END IF NEXT ELSE @@ -12487,7 +12568,7 @@ IF idemode THEN GOTO ideret6 No_C_Compile: -IF compfailed <> 0 AND ConsoleMode = 0 THEN END 1 +IF (compfailed <> 0 OR warningsissued <> 0) AND ConsoleMode = 0 THEN END 1 IF compfailed <> 0 THEN SYSTEM 1 SYSTEM 0 @@ -12575,7 +12656,9 @@ IF idemode THEN END IF 'non-ide mode output PRINT +IF ColorVerboseMode THEN COLOR 4 PRINT a$ +IF ColorVerboseMode THEN COLOR 7 FOR i = 1 TO LEN(linefragment) IF MID$(linefragment, i, 1) = sp$ THEN MID$(linefragment, i, 1) = " " NEXT @@ -12583,7 +12666,12 @@ FOR i = 1 TO LEN(wholeline) IF MID$(wholeline, i, 1) = sp$ THEN MID$(wholeline, i, 1) = " " NEXT PRINT "Caused by (or after):" + linefragment -PRINT "LINE " + str2(linenumber) + ":" + wholeline +IF ColorVerboseMode THEN COLOR 8 +PRINT "LINE "; +IF ColorVerboseMode THEN COLOR 15 +PRINT str2(linenumber) + ":"; +IF ColorVerboseMode THEN COLOR 7 +PRINT wholeline IF ConsoleMode THEN SYSTEM 1 END 1 @@ -12605,6 +12693,7 @@ FUNCTION ParseCMDLineArgs$ () PRINT "Options:" PRINT " Source file to load" ' '80 columns PRINT " -v Verbose mode" + PRINT " -vc Verbose mode with color" PRINT " -q Quiet mode" PRINT " -c Compile instead of edit" PRINT " -x Compile instead of edit and output the result to the" @@ -12622,6 +12711,7 @@ FUNCTION ParseCMDLineArgs$ () CASE "-v" 'Verbose mode VerboseMode = -1 cmdlineswitch = -1 + IF LCASE$(token$) = "-vc" THEN ColorVerboseMode = -1 CASE "-q" 'Quiet mode QuietMode = -1 cmdlineswitch = -1 @@ -25193,6 +25283,7 @@ END SUB SUB addWarning (whichLineNumber AS LONG, includeLevel AS LONG, incLineNumber AS LONG, incFileName$, text$) IF NOT IgnoreWarnings THEN + warningsissued = -1 IF whichLineNumber > 0 THEN totalWarnings = totalWarnings + 1 ELSE From 4dd5d11c8c28133a2be6d75617813daeda83c5ac Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 21:19:21 -0300 Subject: [PATCH 7/9] Improves console output in verbose mode. --- source/qb64.bas | 240 +++++++++++++++--------------------------------- 1 file changed, 76 insertions(+), 164 deletions(-) diff --git a/source/qb64.bas b/source/qb64.bas index d92512c82..7a0a703fa 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -104,7 +104,7 @@ TYPE usedVarList END TYPE REDIM SHARED usedVariableList(1000) AS usedVarList, totalVariablesCreated AS LONG -DIM SHARED totalUnusedVariables AS LONG, bypassNextVariable AS _BYTE +DIM SHARED bypassNextVariable AS _BYTE DIM SHARED totalWarnings AS LONG, warningListItems AS LONG, lastWarningHeader AS STRING DIM SHARED duplicateConstWarning AS _BYTE, warningsissued AS _BYTE DIM SHARED emptySCWarning AS _BYTE @@ -1130,6 +1130,7 @@ f$ = LTRIM$(RTRIM$(f$)) IF FileHasExtension(f$) = 0 THEN f$ = f$ + ".bas" sourcefile$ = f$ +CMDLineFile = sourcefile$ 'derive name from sourcefile f$ = RemoveFileExtension$(f$) @@ -1417,7 +1418,6 @@ subfunc = "" SelectCaseCounter = 0 ExecCounter = 0 UserDefineCount = 6 -totalUnusedVariables = 0 totalVariablesCreated = 0 totalWarnings = 0 duplicateConstWarning = 0 @@ -1571,7 +1571,7 @@ IF idemode THEN GOTO ideret1 IF NOT QuietMode THEN PRINT - PRINT "Beginning C++ output from QB64 code... "; + PRINT "Beginning C++ output from QB64 code... " END IF lineinput3load sourcefile$ @@ -2153,51 +2153,7 @@ DO END IF IF issueWarning THEN IF NOT IgnoreWarnings THEN - addWarning 0, 0, 0, "", "Constant already defined (same value):" - addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), n$ + " =" + thisconstval$ - IF idemode = 0 AND NOT QuietMode THEN - IF ColorVerboseMode THEN COLOR 5 - IF duplicateConstWarning = 0 THEN PRINT: PRINT "Warning: "; - IF ColorVerboseMode THEN COLOR 7 - PRINT "duplicate constant definition"; - IF VerboseMode THEN - thisincname$ = getfilepath$(incname$(inclevel)) - thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) - IF inclevel = 0 THEN - IF ColorVerboseMode THEN COLOR 8 - PRINT ": '"; - IF ColorVerboseMode THEN COLOR 15 - PRINT n$; - IF ColorVerboseMode THEN COLOR 8 - PRINT "' (line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(linenumber); - IF ColorVerboseMode THEN COLOR 8 - PRINT ")" - ELSE - IF ColorVerboseMode THEN COLOR 8 - PRINT ": '"; - IF ColorVerboseMode THEN COLOR 15 - PRINT n$; - IF ColorVerboseMode THEN COLOR 8 - PRINT "' (line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(linenumber); - IF ColorVerboseMode THEN COLOR 8 - PRINT " in file '"; - IF ColorVerboseMode THEN COLOR 2 - PRINT thisincname$; - IF ColorVerboseMode THEN COLOR 8 - PRINT "')" - END IF - IF ColorVerboseMode THEN COLOR 7 - ELSE - IF duplicateConstWarning = 0 THEN - duplicateConstWarning = -1 - PRINT - END IF - END IF - END IF + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "duplicate constant definition", n$ + " =" + thisconstval$ END IF GOTO constAddDone ELSE @@ -2652,7 +2608,7 @@ IF declaringlibrary THEN declaringlibrary = 0 'ignore this error so that auto-fo totallinenumber = reallinenumber -IF idemode = 0 AND NOT QuietMode THEN PRINT "first pass finished.": PRINT "Translating code... " +'IF idemode = 0 AND NOT QuietMode THEN PRINT "first pass finished.": PRINT "Translating code... " 'prepass finished @@ -2787,7 +2743,7 @@ DO layout = "" layoutok = 1 - IF idemode = 0 AND NOT QuietMode THEN + IF idemode = 0 AND NOT QuietMode AND NOT VerboseMode THEN 'IF LEN(a3$) THEN ' dotlinecount = dotlinecount + 1: IF dotlinecount >= 100 THEN dotlinecount = 0: PRINT "."; 'END IF @@ -5907,47 +5863,7 @@ DO IF SelectCaseCounter > 0 AND SelectCaseHasCaseBlock(SelectCaseCounter) = 0 THEN 'warn user of empty SELECT CASE block IF NOT IgnoreWarnings THEN - addWarning 0, 0, 0, "", "Empty SELECT CASE block:" - addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "END SELECT" - IF idemode = 0 AND NOT QuietMode THEN - IF ColorVerboseMode THEN COLOR 5 - IF emptySCWarning = 0 THEN PRINT: PRINT "Warning: "; - IF ColorVerboseMode THEN COLOR 7 - PRINT "Empty SELECT CASE block"; - IF VerboseMode THEN - IF ColorVerboseMode THEN COLOR 8 - PRINT ": "; - IF ColorVerboseMode THEN COLOR 15 - PRINT "'END SELECT' "; - IF inclevel = 0 THEN - IF ColorVerboseMode THEN COLOR 8 - PRINT "(line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(linenumber); - IF ColorVerboseMode THEN COLOR 8 - PRINT ")" - ELSE - thisincname$ = getfilepath$(incname$(inclevel)) - thisincname$ = MID$(incname$(inclevel), LEN(thisincname$) + 1) - IF ColorVerboseMode THEN COLOR 8 - PRINT "' (line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(linenumber); - IF ColorVerboseMode THEN COLOR 8 - PRINT " in file '"; - IF ColorVerboseMode THEN COLOR 2 - PRINT thisincname$; - IF ColorVerboseMode THEN COLOR 8 - PRINT "')" - END IF - IF ColorVerboseMode THEN COLOR 7 - ELSE - IF emptySCWarning = 0 THEN - emptySCWarning = -1 - PRINT - END IF - END IF - END IF + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "empty SELECT CASE block", "" END IF END IF @@ -11563,7 +11479,7 @@ OPEN tmpdir$ + "temp.bin" FOR OUTPUT LOCK WRITE AS #26 'relock compilelog$ = tmpdir$ + "compilelog.txt" OPEN compilelog$ FOR OUTPUT AS #1: CLOSE #1 'Clear log -IF idemode = 0 AND NOT QuietMode THEN +IF idemode = 0 AND NOT QuietMode AND NOT VerboseMode THEN IF ConsoleMode THEN PRINT "[" + STRING$(maxprogresswidth, ".") + "] 100%" ELSE @@ -11577,58 +11493,27 @@ END IF 'PUT #1, 1, usedVariableList$ 'warning$(1) 'CLOSE #1 IF NOT IgnoreWarnings THEN - IF totalUnusedVariables > 0 THEN - IF idemode = 0 AND NOT QuietMode THEN - PRINT - IF ColorVerboseMode THEN COLOR 5 - PRINT "Warning:"; - IF ColorVerboseMode THEN COLOR 7 - PRINT STR$(totalUnusedVariables); " unused variable"; - IF totalUnusedVariables > 1 THEN PRINT "s"; - IF VerboseMode THEN - PRINT ":" - FOR i = 1 TO totalVariablesCreated - IF usedVariableList(i).used = 0 THEN - IF ColorVerboseMode THEN COLOR 8 - PRINT SPACE$(4); usedVariableList(i).name; " ("; usedVariableList(i).cname; ", "; - IF usedVariableList(i).includeLevel > 0 THEN - PRINT "line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(usedVariableList(i).includedLine); - IF ColorVerboseMode THEN COLOR 8 - PRINT " in file '"; - IF ColorVerboseMode THEN COLOR 2 - PRINT usedVariableList(i).includedFile; - IF ColorVerboseMode THEN COLOR 8 - PRINT "')" - ELSE - PRINT "line"; - IF ColorVerboseMode THEN COLOR 15 - PRINT STR$(usedVariableList(i).linenumber); - IF ColorVerboseMode THEN COLOR 8 - PRINT ")" - END IF - IF ColorVerboseMode THEN COLOR 7 - END IF - NEXT - ELSE - PRINT - END IF - ELSE - maxVarNameLen = 0 - FOR i = 1 TO totalVariablesCreated - IF usedVariableList(i).used = 0 THEN - IF LEN(usedVariableList(i).name) > maxVarNameLen THEN maxVarNameLen = LEN(usedVariableList(i).name) - END IF - NEXT - - addWarning 0, 0, 0, "", "Unused variables (" + LTRIM$(STR$(totalUnusedVariables)) + "):" - FOR i = 1 TO totalVariablesCreated - IF usedVariableList(i).used = 0 THEN - addWarning usedVariableList(i).linenumber, usedVariableList(i).includeLevel, usedVariableList(i).includedLine, usedVariableList(i).includedFile, usedVariableList(i).name + SPACE$((maxVarNameLen + 1) - LEN(usedVariableList(i).name)) + " (" + usedVariableList(i).cname + ")" - END IF - NEXT + totalUnusedVariables = 0 + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + totalUnusedVariables = totalUnusedVariables + 1 END IF + NEXT + + IF totalUnusedVariables > 0 THEN + maxVarNameLen = 0 + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + IF LEN(usedVariableList(i).name) > maxVarNameLen THEN maxVarNameLen = LEN(usedVariableList(i).name) + END IF + NEXT + + header$ = "unused variable" 's (" + LTRIM$(STR$(totalUnusedVariables)) + ")" + FOR i = 1 TO totalVariablesCreated + IF usedVariableList(i).used = 0 THEN + addWarning usedVariableList(i).linenumber, usedVariableList(i).includeLevel, usedVariableList(i).includedLine, usedVariableList(i).includedFile, header$, usedVariableList(i).name + SPACE$((maxVarNameLen + 1) - LEN(usedVariableList(i).name)) + " (" + usedVariableList(i).cname + ")" + END IF + NEXT END IF END IF @@ -21612,7 +21497,7 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG) END SUB FUNCTION str2$ (v AS LONG) - str2$ = LTRIM$(RTRIM$(STR$(v))) + str2$ = _TRIM$(STR$(v)) END FUNCTION FUNCTION str2u64$ (v~&&) @@ -25270,40 +25155,67 @@ SUB manageVariableList (name$, __cname$, action AS _BYTE) END IF usedVariableList(i).cname = cname$ usedVariableList(i).name = name$ - totalUnusedVariables = totalUnusedVariables + 1 totalVariablesCreated = totalVariablesCreated + 1 END IF CASE ELSE 'find and mark as used IF found THEN usedVariableList(i).used = -1 - totalUnusedVariables = totalUnusedVariables - 1 END IF END SELECT END SUB -SUB addWarning (whichLineNumber AS LONG, includeLevel AS LONG, incLineNumber AS LONG, incFileName$, text$) - IF NOT IgnoreWarnings THEN - warningsissued = -1 - IF whichLineNumber > 0 THEN - totalWarnings = totalWarnings + 1 +SUB addWarning (whichLineNumber AS LONG, includeLevel AS LONG, incLineNumber AS LONG, incFileName$, header$, text$) + warningsissued = -1 + totalWarnings = totalWarnings + 1 + + IF idemode = 0 AND NOT QuietMode AND VerboseMode THEN + thissource$ = getfilepath$(CMDLineFile) + thissource$ = MID$(CMDLineFile, LEN(thissource$) + 1) + thisincname$ = getfilepath$(incFileName$) + thisincname$ = MID$(incFileName$, LEN(thisincname$) + 1) + + IF ColorVerboseMode THEN COLOR 15 + IF includeLevel > 0 AND incLineNumber > 0 THEN + PRINT thisincname$; ":"; + PRINT str2$(incLineNumber); ": "; ELSE - IF lastWarningHeader = text$ THEN - EXIT SUB - ELSE - lastWarningHeader = text$ - END IF + PRINT thissource$; ":"; + PRINT str2$(whichLineNumber); ": "; END IF - warningListItems = warningListItems + 1 - IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) - IF includeLevel > 0 THEN - thisincname$ = getfilepath$(incFileName$) - thisincname$ = MID$(incFileName$, LEN(thisincname$) + 1) - warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(includeLevel) + MKL$(incLineNumber) + thisincname$ + CHR$(2) + text$ - ELSE - warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(0) + CHR$(2) + text$ + IF ColorVerboseMode THEN COLOR 13 + PRINT "warning: "; + IF ColorVerboseMode THEN COLOR 7 + PRINT header$ + + IF LEN(text$) > 0 THEN + IF ColorVerboseMode THEN COLOR 2 + PRINT SPACE$(4); text$ + IF ColorVerboseMode THEN COLOR 7 + END IF + ELSEIF idemode THEN + IF NOT IgnoreWarnings THEN + IF lastWarningHeader <> header$ THEN + lastWarningHeader = header$ + GOSUB increaseWarningCount + warning$(warningListItems) = MKL$(0) + CHR$(2) + header$ + END IF + + GOSUB increaseWarningCount + IF includeLevel > 0 THEN + thisincname$ = getfilepath$(incFileName$) + thisincname$ = MID$(incFileName$, LEN(thisincname$) + 1) + warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(includeLevel) + MKL$(incLineNumber) + thisincname$ + CHR$(2) + text$ + ELSE + warning$(warningListItems) = MKL$(whichLineNumber) + MKL$(0) + CHR$(2) + text$ + END IF END IF END IF + EXIT SUB + increaseWarningCount: + warningListItems = warningListItems + 1 + IF warningListItems > UBOUND(warning$) THEN REDIM _PRESERVE warning$(warningListItems + 999) + RETURN END SUB '$INCLUDE:'utilities\strings.bas' From ec4b4d436bd149cc9a8208db2e7c03cade63d670 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 23:47:27 -0300 Subject: [PATCH 8/9] Organizes the visualization of warnings in the IDE. - Adds color coding to listbox controls. - Extends SUBs dialog with color coding for columns. --- source/ide/ide_methods.bas | 84 +++++++++++++++++++++++++++++++------- 1 file changed, 69 insertions(+), 15 deletions(-) diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index a04d22b87..1013a31d8 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -6698,9 +6698,36 @@ SUB idedrawobj (o AS idedbotype, f) IF o.sel = n THEN COLOR 7, 0 ELSE COLOR 0, 7 IF (o.sel = n OR -o.sel = n) AND o.foc = 0 THEN o.cx = o.par.x + o.x + 2: o.cy = o.par.y + o.y + y LOCATE o.par.y + o.y + y, o.par.x + o.x + 1 - a3$ = " " + a3$ + SPACE$(o.w) - a3$ = LEFT$(a3$, o.w) - PRINT a3$; + a3$ = " " + a3$ + IF INSTR(a3$, CHR$(16)) THEN + 'color formatting: CHR$(16) + CHR$(color) + ' CHR$(16) + CHR$(16) restores default + position = 0: character = 0 + FOR cf = POS(1) TO POS(1) + o.w + character = character + 1 + IF character > LEN(a3$) THEN + PRINT SPACE$(o.w - (POS(1) - (o.par.x + o.x)) + 1); + EXIT FOR + END IF + IF ASC(a3$, character) = 16 AND character < LEN(a3$) THEN + IF ASC(a3$, character + 1) >= 0 AND ASC(a3$, character + 1) <= 15 THEN + COLOR ASC(a3$, character + 1) + character = character + 1 + _CONTINUE + ELSEIF ASC(a3$, character + 1) = 16 THEN + IF o.sel = n THEN COLOR 7 ELSE COLOR 0 + character = character + 1 + _CONTINUE + END IF + END IF + position = position + 1 + PRINT MID$(a3$, character, 1); + NEXT + ELSE + a3$ = a3$ + SPACE$(o.w) + a3$ = LEFT$(a3$, o.w) + PRINT a3$; + END IF 'customization specific for the SUBs list, when there are external procedures: IF INSTR(a3$, CHR$(196) + "*") > 0 THEN IF o.sel = n THEN COLOR 2, 0 ELSE COLOR 2, 7 @@ -8774,8 +8801,8 @@ FUNCTION idesubs$ num$ = LTRIM$(STR$(TotalLines(TotalSUBs))) IF pInsideDECLARE THEN num$ = "external" lSized$ = lSized$ + CHR$(195) + CHR$(196) + pn$ + " " + _ - SPACE$(9 - LEN(num$)) + num$ + " " _ - + psf$ + pargs$ + sep + CHR$(16) + CHR$(2) + SPACE$(9 - LEN(num$)) + num$ + " " _ + + psf$ + CHR$(16) + CHR$(16) + pargs$ + sep END IF IF LEN(n$) <= 20 THEN @@ -8788,7 +8815,8 @@ FUNCTION idesubs$ ELSE args$ = LEFT$(args$, (idewx - 44)) + STRING$(3, 250) END IF - l$ = l$ + sep + CHR$(195) + CHR$(196) + n$ + " " + sf$ + args$ + l$ = l$ + sep + CHR$(195) + CHR$(196) + n$ + " " + CHR$(16) + CHR$(2) + _ + sf$ + CHR$(16) + CHR$(16) + args$ psf$ = sf$ pn$ = n$ pargs$ = args$ @@ -8800,7 +8828,7 @@ FUNCTION idesubs$ REDIM _PRESERVE SortedSubsList(1 TO TotalSUBs) AS STRING * 998 REDIM _PRESERVE CaseBkpSubsList(1 TO TotalSUBs) AS STRING * 998 REDIM _PRESERVE TotalLines(0 TO TotalSUBs) AS LONG - CaseBkpSubsList(TotalSUBs) = n$ + " " + CHR$(1) + sf$ + args$ + CaseBkpSubsList(TotalSUBs) = n$ + " " + CHR$(1) + CHR$(16) + CHR$(2) + sf$ + CHR$(16) + CHR$(16) + args$ SortedSubsList(TotalSUBs) = UCASE$(CaseBkpSubsList(TotalSUBs)) MID$(CaseBkpSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) MID$(SortedSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) @@ -8832,7 +8860,8 @@ FUNCTION idesubs$ num$ = LTRIM$(STR$(TotalLines(TotalSUBs))) IF pInsideDECLARE THEN num$ = "external" lSized$ = lSized$ + CHR$(195) + CHR$(196) + pn$ + " " + _ - SPACE$(9 - LEN(num$)) + num$ + " " + psf$ + pargs$ + SPACE$(9 - LEN(num$)) + CHR$(16) + CHR$(2) + num$ + " " + _ + psf$ + CHR$(16) + CHR$(16) + pargs$ END IF MID$(l$, _INSTRREV(l$, CHR$(195)), 1) = CHR$(192) @@ -8855,7 +8884,7 @@ FUNCTION idesubs$ IF LEFT$(temp$, 1) = "*" THEN num$ = "external" lSortedSized$ = lSortedSized$ + sep + CHR$(195) + CHR$(196) lSortedSized$ = lSortedSized$ + LEFT$(temp$, INSTR(temp$, CHR$(1)) - 1) + _ - SPACE$(9 - LEN(num$)) + num$ + " " + _ + SPACE$(9 - LEN(num$)) + CHR$(16) + CHR$(2) + num$ + " " + _ MID$(temp$, INSTR(temp$, CHR$(1)) + 1) EXIT FOR END IF @@ -9290,22 +9319,47 @@ FUNCTION idewarningbox DIM warningIncLines(1 TO warningListItems) AS LONG DIM warningIncFiles(1 TO warningListItems) AS STRING + IF LEN(ideprogname) THEN thisprog$ = ideprogname ELSE thisprog$ = "Untitled" + tempfolderindexstr$ + maxModuleNameLen = LEN(thisprog$) + + 'fill arrays FOR x = 1 TO warningListItems warningLines(x) = CVL(LEFT$(warning$(x), 4)) + IF warningLines(x) = 0 THEN _CONTINUE + + warningIncLevel = CVL(MID$(warning$(x), 5, 4)) + IF warningIncLevel > 0 THEN + warningIncLines(x) = CVL(MID$(warning$(x), 9, 4)) + warningIncFiles(x) = MID$(warning$(x), 13, INSTR(warning$(x), CHR$(2)) - 13) + IF LEN(warningIncFiles(x)) > maxModuleNameLen THEN + maxModuleNameLen = LEN(warningIncFiles(x)) + END IF + END IF + NEXT + + 'build list + FOR x = 1 TO warningListItems IF warningLines(x) = 0 THEN l$ = l$ + MID$(warning$(x), INSTR(warning$(x), CHR$(2)) + 1) IF x > 1 THEN ASC(l$, treeConnection) = 192 ELSE - warningIncLevel = CVL(MID$(warning$(x), 5, 4)) + l3$ = CHR$(16) + CHR$(2) 'dark grey IF warningIncLevel > 0 THEN - warningIncLines(x) = CVL(MID$(warning$(x), 9, 4)) - warningIncFiles(x) = MID$(warning$(x), 13, INSTR(warning$(x), CHR$(2)) - 13) - l3$ = "line" + STR$(warningIncLines(x)) + " in '" + warningIncFiles(x) + "'" + num$ = SPACE$(maxLineNumberLength) + RSET num$ = str2$(warningIncLines(x)) + l3$ = l3$ + warningIncFiles(x) + SPACE$(maxModuleNameLen - LEN(warningIncFiles(x))) + ":" + CHR$(16) + CHR$(16) + num$ ELSE - l3$ = "line" + STR$(warningLines(x)) + num$ = SPACE$(maxLineNumberLength) + RSET num$ = str2$(warningLines(x)) + l3$ = l3$ + thisprog$ + SPACE$(maxModuleNameLen - LEN(thisprog$)) + ":" + CHR$(16) + CHR$(16) + num$ END IF treeConnection = LEN(l$) + 1 - l$ = l$ + CHR$(195) + CHR$(196) + l3$ + ": " + MID$(warning$(x), INSTR(warning$(x), CHR$(2)) + 1) + text$ = MID$(warning$(x), INSTR(warning$(x), CHR$(2)) + 1) + IF LEN(text$) THEN + l$ = l$ + CHR$(195) + CHR$(196) + l3$ + ": " + text$ + ELSE + l$ = l$ + CHR$(195) + CHR$(196) + l3$ + END IF END IF IF x < warningListItems THEN l$ = l$ + sep NEXT From 2ce9afe73918baf955fce8e42d72916cffe33098 Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Wed, 13 Jan 2021 23:54:20 -0300 Subject: [PATCH 9/9] Makes colored output default for command line compilation. --- source/qb64.bas | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/source/qb64.bas b/source/qb64.bas index 7a0a703fa..c4bfe40df 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -12577,8 +12577,8 @@ FUNCTION ParseCMDLineArgs$ () PRINT PRINT "Options:" PRINT " Source file to load" ' '80 columns - PRINT " -v Verbose mode" - PRINT " -vc Verbose mode with color" + PRINT " -v Verbose mode (colorized)" + PRINT " -vc Verbose mode (no color)" PRINT " -q Quiet mode" PRINT " -c Compile instead of edit" PRINT " -x Compile instead of edit and output the result to the" @@ -12596,7 +12596,8 @@ FUNCTION ParseCMDLineArgs$ () CASE "-v" 'Verbose mode VerboseMode = -1 cmdlineswitch = -1 - IF LCASE$(token$) = "-vc" THEN ColorVerboseMode = -1 + ColorVerboseMode = -1 + IF LCASE$(token$) = "-vc" THEN ColorVerboseMode = 0 CASE "-q" 'Quiet mode QuietMode = -1 cmdlineswitch = -1