1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-03 11:11:21 +00:00

Merge pull request #105 from QB64Team/ideimprovements

Ideimprovements
This commit is contained in:
Fellippe Heitor 2021-01-14 00:01:26 -03:00 committed by GitHub
commit 986365e3ed
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 409 additions and 712 deletions

View file

@ -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
@ -2827,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$
@ -3135,7 +3138,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
@ -4957,8 +4960,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
@ -5593,7 +5595,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
@ -6695,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$ = " " + 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
@ -7361,7 +7391,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 +7407,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 +7556,34 @@ SUB idenewsf (sf AS STRING)
END IF
END IF
i = 0
newSF$ = ideinputbox$("New " + sf$, "#Name", a2$, "", 60, 40)
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
IF LEN(newSF$) THEN
y = iden
y = y + 1: idesetline y, ""
y = y + 1: idesetline y, sf$ + " " + idetxt(o(1).txt)
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
EXIT SUB
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
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
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)
IF LEN(newfolder$) THEN
IF _DIREXISTS(thispath$ + idepathsep$ + newfolder$) THEN
idenewfolder$ = newfolder$
EXIT SUB
END IF
ideerror = 5
MKDIR thispath$ + idepathsep$ + idetxt(o(1).txt)
MKDIR thispath$ + idepathsep$ + newfolder$
ideerror = 1
idenewfolder$ = idetxt(o(1).txt)
EXIT SUB
idenewfolder$ = newfolder$
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
END SUB
@ -8074,14 +7992,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$
@ -8882,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
@ -8896,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$
@ -8908,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)
@ -8940,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)
@ -8963,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
@ -9395,18 +9316,50 @@ FUNCTION idewarningbox
'-------- init --------
DIM warningLines(1 TO warningListItems) AS LONG
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), 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$
l3$ = CHR$(16) + CHR$(2) 'dark grey
IF warningIncLevel > 0 THEN
num$ = SPACE$(maxLineNumberLength)
RSET num$ = str2$(warningIncLines(x))
l3$ = l3$ + warningIncFiles(x) + SPACE$(maxModuleNameLen - LEN(warningIncFiles(x))) + ":" + CHR$(16) + CHR$(16) + num$
ELSE
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), 5)
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
@ -9525,6 +9478,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
@ -10760,281 +10717,11 @@ 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"
SUB idegotobox
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 SUB
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
@ -11042,17 +10729,7 @@ FUNCTION idegotobox
AddQuickNavHistory idecy
idecy = v&
ideselect = 0
EXIT FUNCTION
END IF
'end of custom controls
mousedown = 0
mouseup = 0
LOOP
idegotobox = 0
END FUNCTION
END SUB

View file

@ -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) --------
@ -92,10 +91,22 @@ _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
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 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
@ -329,6 +340,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$
@ -1102,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$
@ -1115,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$)
@ -1402,8 +1418,7 @@ subfunc = ""
SelectCaseCounter = 0
ExecCounter = 0
UserDefineCount = 6
usedVariableList$ = ""
totalUnusedVariables = 0
totalVariablesCreated = 0
totalWarnings = 0
duplicateConstWarning = 0
emptySCWarning = 0
@ -1556,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$
@ -2124,33 +2139,21 @@ 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$
IF idemode = 0 THEN
IF duplicateConstWarning = 0 THEN PRINT: PRINT "Warning: duplicate constant definition";
IF VerboseMode THEN
PRINT ": '"; n$; "' (line"; STR$(linenumber); ")"
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
@ -2605,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
@ -2740,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
@ -5860,19 +5863,7 @@ 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"
IF idemode = 0 THEN
IF emptySCWarning = 0 THEN PRINT: PRINT "Warning: Empty SELECT CASE block";
IF VerboseMode THEN
PRINT ": 'END SELECT' (line"; STR$(linenumber); ")"
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
@ -11488,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
@ -11502,56 +11493,27 @@ END IF
'PUT #1, 1, usedVariableList$ 'warning$(1)
'CLOSE #1
IF NOT IgnoreWarnings THEN
IF totalUnusedVariables > 0 THEN
IF idemode = 0 THEN
PRINT
PRINT "Warning:"; STR$(totalUnusedVariables); " unused variable";
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
ELSE
PRINT
totalUnusedVariables = 0
FOR i = 1 TO totalVariablesCreated
IF usedVariableList(i).used = 0 THEN
totalUnusedVariables = totalUnusedVariables + 1
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
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
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
@ -12491,7 +12453,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
@ -12579,7 +12541,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
@ -12587,7 +12551,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
@ -12608,7 +12577,8 @@ FUNCTION ParseCMDLineArgs$ ()
PRINT
PRINT "Options:"
PRINT " <file> Source file to load" ' '80 columns
PRINT " -v Verbose mode"
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"
@ -12626,6 +12596,8 @@ FUNCTION ParseCMDLineArgs$ ()
CASE "-v" 'Verbose mode
VerboseMode = -1
cmdlineswitch = -1
ColorVerboseMode = -1
IF LCASE$(token$) = "-vc" THEN ColorVerboseMode = 0
CASE "-q" 'Quiet mode
QuietMode = -1
cmdlineswitch = -1
@ -21526,7 +21498,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~&&)
@ -25151,7 +25123,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$, "[")
@ -25159,50 +25131,98 @@ 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) + CHR$(2)
usedVariableList$ = usedVariableList$ + "VAR:" + s$ + name$ + CHR$(10)
totalUnusedVariables = totalUnusedVariables + 1
'warning$(1) = warning$(1) + "Adding " + cname$ + " at line" + STR$(linenumber) + CHR$(10)
IF found = 0 THEN
IF i > UBOUND(usedVariableList) THEN
REDIM _PRESERVE usedVariableList(UBOUND(usedVariableList) + 999) AS usedVarList
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
totalUnusedVariables = totalUnusedVariables - 1
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$
totalVariablesCreated = totalVariablesCreated + 1
END IF
CASE ELSE 'find and mark as used
IF found THEN
usedVariableList(i).used = -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$)
IF NOT IgnoreWarnings THEN
IF lineNumber > 0 THEN
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
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)
warning$(warningListItems) = MKL$(lineNumber) + text$
END IF
RETURN
END SUB
'$INCLUDE:'utilities\strings.bas'
'$INCLUDE:'subs_functions\extensions\opengl\opengl_methods.bas'
'INCLUDE:'qb_framework\qb_framework_methods.bas'
DEFLNG A-Z
'-------- Optional IDE Component (2/2) --------