QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-05 19:20:25 +00:00
Code Releases Wiki Activity

Fix to IDE color config file to not use an user-addition routine in QB64.bas

Browse source 
(gives "not defined in this scope" error for some reason.
Fix to PRINT USING which the auto-semicolon insertion routine messed up.
Fix to DATA.x where the . would count as a variable no matter where it was found in the DATA line.  (Data "Mr. X" would try and turn itself in a variable and error).
This commit is contained in:
SMcNeill 2015-07-13 22:29:51 -04:00
parent a38a3ddad3
commit 8b02aafd8c
1 changed files with 78 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

141
source/qb64.bas
View file

@ -8904,40 +8904,42 @@ DO
END IF '"print" END IF '"print"
IF firstelement$ = "PRINT" OR firstelement$ = "LPRINT" THEN IF firstelement$ = "PRINT" OR firstelement$ = "LPRINT" THEN
elementon = 2 IF secondelement$ <> "USING" THEN 'check to see if we need to auto-add semicolons
redosemi: elementon = 2
FOR i = elementon TO n - 1 redosemi:
nextchar$ = getelement$(a$, i + 1) FOR i = elementon TO n - 1
IF nextchar$ <> ";" AND nextchar$ <> "," AND nextchar$ <> "+" AND nextchar$ <> ")" THEN nextchar$ = getelement$(a$, i + 1)
temp1$ = getelement$(a$, i) IF nextchar$ <> ";" AND nextchar$ <> "," AND nextchar$ <> "+" AND nextchar$ <> ")" THEN
beginpoint = INSTR(beginpoint, temp1$, CHR$(34)) temp1$ = getelement$(a$, i)
endpoint = INSTR(beginpoint + 1, temp1$, CHR$(34) + ",") beginpoint = INSTR(beginpoint, temp1$, CHR$(34))
IF beginpoint <> 0 AND endpoint <> 0 THEN 'if we have both positions endpoint = INSTR(beginpoint + 1, temp1$, CHR$(34) + ",")
'Quote without semicolon check (like PRINT "abc"123) IF beginpoint <> 0 AND endpoint <> 0 THEN 'if we have both positions
textlength = endpoint - beginpoint - 1 'Quote without semicolon check (like PRINT "abc"123)
textvalue$ = MID$(temp1$, endpoint + 2, LEN(LTRIM$(STR$(textlength)))) textlength = endpoint - beginpoint - 1
IF VAL(textvalue$) = textlength THEN textvalue$ = MID$(temp1$, endpoint + 2, LEN(LTRIM$(STR$(textlength))))
insertelements a$, i, ";" IF VAL(textvalue$) = textlength THEN
insertelements ca$, i, ";" insertelements a$, i, ";"
n = n + 1 insertelements ca$, i, ";"
elementon = i + 2 'just a easy way to reduce redundant calls to the routine n = n + 1
GOTO redosemi elementon = i + 2 'just a easy way to reduce redundant calls to the routine
GOTO redosemi
END IF
END IF
'Values before Quote check will go here once my brain stops smoking from sorting out the other half
'This will fix things like PRINT 123"xyz" to make it PRINT 123; xyz once it's implemented.
'Brain smoke clear; let's finish this up!
IF LEFT$(LTRIM$(nextchar$), 1) = CHR$(34) THEN
IF temp1$ <> ";" AND temp1$ <> "," AND temp1$ <> "+" AND temp1$ <> "(" THEN
insertelements a$, i, ";"
insertelements ca$, i, ";"
n = n + 1
elementon = i + 2 'just a easy way to reduce redundant calls to the routine
GOTO redosemi
END IF
END IF END IF
END IF END IF
'Values before Quote check will go here once my brain stops smoking from sorting out the other half NEXT
'This will fix things like PRINT 123"xyz" to make it PRINT 123; xyz once it's implemented. END IF
'Brain smoke clear; let's finish this up!
IF LEFT$(LTRIM$(nextchar$), 1) = CHR$(34) THEN
IF temp1$ <> ";" AND temp1$ <> "," AND temp1$ <> "+" AND temp1$ <> "(" THEN
insertelements a$, i, ";"
insertelements ca$, i, ";"
n = n + 1
elementon = i + 2 'just a easy way to reduce redundant calls to the routine
GOTO redosemi
END IF
END IF
END IF
NEXT
xprint a$, ca$, n xprint a$, ca$, n
IF Error_Happened THEN GOTO errmes IF Error_Happened THEN GOTO errmes
@ -18493,7 +18495,7 @@ IF (c >= 65 AND c <= 90) OR c = 95 THEN 'A-Z(a-z) or _
i = i + n2 i = i + n2
IF i < n THEN IF i < n THEN
c = ASC(a$, i) c = ASC(a$, i)
IF c = 46 THEN a2$ = a2$ + sp + MID$(ca$, i - n2, n2): GOTO extcheck 'data.Variable is a valid variable name in QB45 IF c = 46 THEN a2$ = a2$ + sp + MID$(ca$, i - n2, n2): GOTO extcheck 'rem.Variable is a valid variable name in QB45
END IF END IF
'note: In QBASIC 'IF cond THEN REM comment' counts as a single line IF statement, however use of ' instead of REM does not 'note: In QBASIC 'IF cond THEN REM comment' counts as a single line IF statement, however use of ' instead of REM does not
@ -18508,6 +18510,11 @@ IF (c >= 65 AND c <= 90) OR c = 95 THEN 'A-Z(a-z) or _
IF a3$ = "DATA" THEN IF a3$ = "DATA" THEN
x$ = "" x$ = ""
i = i + n2 i = i + n2
IF i < n THEN
c = ASC(a$, i)
IF c = 46 THEN a2$ = a2$ + sp + MID$(ca$, i - n2, n2): GOTO extcheck 'data.Variable is a valid variable name in QB45
END IF
scan = 0 scan = 0
speechmarks = 0 speechmarks = 0
commanext = 0 commanext = 0
@ -18518,9 +18525,6 @@ IF (c >= 65 AND c <= 90) OR c = 95 THEN 'A-Z(a-z) or _
nextdatachr: nextdatachr:
IF i < n THEN IF i < n THEN
c = ASC(a$, i) c = ASC(a$, i)
IF c = 46 THEN a2$ = a2$ + sp + MID$(ca$, i - n2, n2): GOTO extcheck 'data.Variable is a valid variable name in QB45
IF c = 9 OR c = 32 THEN IF c = 9 OR c = 32 THEN
IF scan = 0 THEN GOTO skipwhitespace IF scan = 0 THEN GOTO skipwhitespace
END IF END IF
@ -24016,27 +24020,36 @@ END FUNCTION
SUB WriteConfigSetting (heading$, item$, value$) SUB WriteConfigSetting (heading$, item$, value$)
SHARED ConfigFile$, ConfigBak$ SHARED ConfigFile$, ConfigBak$
DIM CRLF AS STRING
IF INSTR(os$, "WIN") THEN CRLF = CHR$(13) + CHR$(10) ELSE CRLF = CHR$(10)
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
OutFile = FREEFILE: OPEN ConfigBak$ FOR OUTPUT AS #OutFile OutFile = FREEFILE: OPEN ConfigBak$ FOR OUTPUT AS #OutFile
placed = 0 placed = 0
'check for quotes where needed for strings
IF RIGHT$(RTRIM$(item$), 1) = "$" THEN
IF LEFT$(value$, 1) <> CHR$(34) THEN value$ = CHR$(34) + value$
IF RIGHT$(value$, 1) <> CHR$(34) THEN value$ = value$ + CHR$(34)
END IF
IF LOF(InFile) THEN IF LOF(InFile) THEN
DO UNTIL EOF(InFile) DO UNTIL EOF(InFile)
LINE INPUT #InFile, junk$ LINE INPUT #InFile, junk$
'we really don't care about heading$ here; it's only used to make things easier for the user to locate in the config file 'we really don't care about heading$ here; it's only used to make things easier for the user to locate in the config file
junk$ = LTRIM$(RTRIM$(junk$)) junk$ = LTRIM$(RTRIM$(junk$))
IF _STRICMP(LEFT$(junk$, LEN(item$)), item$) = 0 THEN l = INSTR(junk$, "=") 'compare the values to the left of the equal sign
compare$ = RTRIM$(LEFT$(junk$, l - 1))
IF UCASE$(compare$) = UCASE$(item$) THEN 'if it's a match, replace it
PRINT #OutFile, item$; " = "; value$ PRINT #OutFile, item$; " = "; value$
placed = -1 placed = -1
ELSE ELSE
PRINT #OutFile, junk$ PRINT #OutFile, junk$ 'otherwise put that line back and check the next one
END IF END IF
LOOP LOOP
END IF END IF
CLOSE #InFile, #OutFile CLOSE #InFile, #OutFile
KILL ConfigFile$
IF NOT placed THEN 'we didn't find the proper setting already in the file somewhere. IF NOT placed THEN 'we didn't find the proper setting already in the file somewhere.
'Either the file was corrupted, or the user deleted this particulat setting sometime in the past. 'Either the file was corrupted, or the user deleted this particulat setting sometime in the past.
'Now we look to see if the heading exists in the file or not. 'Now we look to see if the heading exists in the file or not.
@ -24044,45 +24057,42 @@ IF NOT placed THEN 'we didn't find the proper setting already in the file somewh
'If not then we write that heading to the end of the file to make it easier for the user to locate in the future 'If not then we write that heading to the end of the file to make it easier for the user to locate in the future
'and then we write it below there. 'and then we write it below there.
OPEN ConfigBak$ FOR BINARY AS #InFile OPEN ConfigBak$ FOR BINARY AS #InFile
l = LOF(InFile) OPEN "internal/config.tmp" FOR OUTPUT AS #OutFile
out$ = item$ + " = " + value$ + CRLF out$ = item$ + " = " + value$
temp$ = SPACE$(l) DO UNTIL EOF(InFile) OR LOF(InFile) = 0
GET #InFile, 1, temp$ LINE INPUT #InFile, temp$
PRINT #OutFile, temp$
l1 = INSTR(temp$, heading$) IF INSTR(temp$, heading$) THEN PRINT #OutFile, out$: placed = -1 'If we have the heading, we want to print the item after it
IF l1 THEN LOOP
l1 = l1 + LEN(heading$) + LEN(CRLF) IF NOT placed THEN 'If the heading doesn't exist already then we'll make the heading and the item
PUT #InFile, l1 + 1, out$ PRINT #OutFile, ""
r$ = MID$(temp$, l1 + 1) PRINT #OutFile, heading$
PUT #InFile, l1 + LEN(out$) + 1, r$ PRINT #OutFile, out$
placed = -1
END IF END IF
IF NOT placed THEN CLOSE #InFile, #OutFile
PUT #InFile, l + 1, CRLF KILL ConfigBak$
PUT #InFile, , heading$ NAME "internal/config.tmp" AS ConfigFile$
PUT #InFile, , CRLF ELSE
PUT #InFile, , out$ NAME ConfigBak$ AS ConfigFile$
END IF
CLOSE InFile
END IF END IF
KILL ConfigFile$
NAME ConfigBak$ AS ConfigFile$
END SUB END SUB
FUNCTION ReadConfigSetting (item$, value$) FUNCTION ReadConfigSetting (item$, value$)
SHARED ConfigFile$ SHARED ConfigFile$
value$ = "" 'We start by blanking the value$ as a default return state value$ = "" 'We start by blanking the value$ as a default return state
InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile InFile = FREEFILE: OPEN ConfigFile$ FOR BINARY AS #InFile
IF LOF(InFile) THEN IF LOF(InFile) THEN
found = 0 found = 0
DO UNTIL EOF(InFile) DO UNTIL EOF(InFile)
LINE INPUT #InFile, temp$ LINE INPUT #InFile, temp$
temp$ = LTRIM$(RTRIM$(temp$)) temp$ = LTRIM$(RTRIM$(temp$))
IF LEFT$(UCASE$(temp$), LEN(item$)) = UCASE$(item$) THEN found = -1: EXIT DO l = INSTR(temp$, "=")
compare$ = LTRIM$(RTRIM$(LEFT$(temp$, l - 1)))
IF UCASE$(compare$) = UCASE$(item$) THEN found = -1: EXIT DO
LOOP LOOP
CLOSE InFile CLOSE InFile
IF found THEN 'we found what we're looking for IF found THEN 'we found what we're looking for
l = INSTR(temp$, "=") 'return the value after the = sign
IF l THEN IF l THEN
value$ = MID$(temp$, l + 1) value$ = MID$(temp$, l + 1)
l = INSTR(value$, CHR$(13)) 'we only want what's before a CR l = INSTR(value$, CHR$(13)) 'we only want what's before a CR
@ -24091,6 +24101,11 @@ IF LOF(InFile) THEN
'These are basic text files; they shouldn't have stray CHR$(10) or CHR$(13) characters in them! 'These are basic text files; they shouldn't have stray CHR$(10) or CHR$(13) characters in them!
IF l THEN value$ = LEFT$(value$, l) IF l THEN value$ = LEFT$(value$, l)
value$ = LTRIM$(RTRIM$(value$)) value$ = LTRIM$(RTRIM$(value$))
'check for quotes where needed for strings and remove them so our return value doesn't contain them
IF RIGHT$(RTRIM$(item$), 1) = "$" THEN
IF LEFT$(value$, 1) = CHR$(34) THEN value$ = MID$(value$, 2)
IF RIGHT$(value$, 1) = CHR$(34) THEN value$ = LEFT$(value$, LEN(value$) - 1)
END IF
ReadConfigSetting = -1 ReadConfigSetting = -1
EXIT FUNCTION EXIT FUNCTION
END IF END IF