diff --git a/source/ide/ide_global.bas b/source/ide/ide_global.bas index bb763a406..e0f88a27c 100644 --- a/source/ide/ide_global.bas +++ b/source/ide/ide_global.bas @@ -210,9 +210,9 @@ END TYPE '-------------------------------------------------------------------------------- DIM SHARED idefocusline 'simply stores the location of the line to highlight in red DIM SHARED ideautorun, startPaused -DIM SHARED menu$(1 TO 11, 0 TO 20) -DIM SHARED menuDesc$(1 TO 11, 0 TO 20) -DIM SHARED menusize(1 TO 11) +DIM SHARED menu$(1 TO 12, 0 TO 20) +DIM SHARED menuDesc$(1 TO 12, 0 TO 20) +DIM SHARED menusize(1 TO 12) DIM SHARED menus AS INTEGER, idecontextualmenuID AS INTEGER DIM SHARED ideeditmenuID AS INTEGER, SearchMenuID AS INTEGER DIM SHARED OptionsMenuID AS INTEGER, OptionsMenuSwapMouse AS INTEGER, OptionsMenuPasteCursor AS INTEGER @@ -220,6 +220,7 @@ DIM SHARED OptionsMenuShowErrorsImmediately AS INTEGER, OptionsMenuIgnoreWarning DIM SHARED OptionsMenuDisableSyntax AS INTEGER ', OptionsMenuAutoComplete DIM SHARED ViewMenuID AS INTEGER, ViewMenuShowLineNumbersSubMenuID AS INTEGER DIM SHARED ViewMenuShowSeparatorID AS INTEGER, ViewMenuShowBGID AS INTEGER +DIM SHARED FileMenuExportAs AS INTEGER, FileMenuExportAsSubMenuID AS INTEGER DIM SHARED ViewMenuCompilerWarnings AS INTEGER DIM SHARED RunMenuID AS INTEGER, RunMenuSaveExeWithSource AS INTEGER, brackethighlight AS INTEGER DIM SHARED GenerateLicenseEnableMenu AS INTEGER diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index a0bf6ba35..3f0141b3e 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -166,6 +166,7 @@ FUNCTION ide2 (ignore) 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 = 7 THEN errorat$ = "Cannot export file" IF ideerror = -1 THEN GOTO errorReportDone 'fail quietly - like ON ERROR RESUME NEXT qberrorcode = ERR @@ -523,6 +524,17 @@ FUNCTION ide2 (ignore) i = i + 1 menusize(m) = i - 1 + 'File Menu sub menu for Export As options + m = m + 1: i = 0: FileMenuExportAsSubMenuID = m + menu$(m, i) = "FileMenuExportAsSubMenu": i = i + 1 + menu$(m, i) = "#Hypertext document (.htm)": i = i + 1 + menuDesc$(m, i - 1) = "Export program into a Hypertext document" + menu$(m, i) = "#Rich Text document (.rtf)": i = i + 1 + menuDesc$(m, i - 1) = "Export program into a Rich Text document" + menu$(m, i) = "#Wiki prepared sample (.txt)": i = i + 1 + menuDesc$(m, i - 1) = "Export program into a Wiki code example" + menusize(m) = i - 1 + IF os$ = "WIN" THEN idepathsep$ = "\" END IF @@ -871,6 +883,7 @@ FUNCTION ide2 (ignore) IF ready THEN IF IDEShowErrorsImmediately THEN _PRINTSTRING (2, idewy - 3), "OK" 'report OK status + IF ideautolayout <> 0 THEN menu$(1, FileMenuExportAs) = "#Export As... " + CHR$(16) statusarealink = 0 IF totalWarnings > 0 AND showexecreated = 0 THEN COLOR 11, 1 @@ -1048,6 +1061,7 @@ FUNCTION ide2 (ignore) IF IDEShowErrorsImmediately <> 0 OR IDECompilationRequested <> 0 OR compfailed <> 0 THEN IF LEFT$(IdeInfo, 19) <> "Selection length = " THEN IdeInfo = "" UpdateIdeInfo + IF ideautolayout <> 0 THEN menu$(1, FileMenuExportAs) = "#Export As... " + CHR$(16) clearStatusWindow 0 'scrolling unavailable, but may span multiple lines @@ -1118,6 +1132,7 @@ FUNCTION ide2 (ignore) clearStatusWindow 0 IdeInfo = "" _PRINTSTRING (2, idewy - 3), STRING$(3, 250) 'assume new compilation will begin "..." + menu$(1, FileMenuExportAs) = "~#Export As... " + CHR$(16) END IF END IF @@ -3055,8 +3070,10 @@ FUNCTION ide2 (ignore) IF IDEShowErrorsImmediately THEN IF idecompiling = 1 THEN _PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..." + menu$(1, FileMenuExportAs) = "~#Export As... " + CHR$(16) ELSE _PRINTSTRING (2, idewy - 3), "OK" 'report OK status + IF ideautolayout <> 0 THEN menu$(1, FileMenuExportAs) = "#Export As... " + CHR$(16) statusarealink = 0 IF totalWarnings > 0 THEN COLOR 11, 1 @@ -4467,6 +4484,12 @@ FUNCTION ide2 (ignore) idectxmenuY = yy + r parentMenu = m m = ViewMenuShowLineNumbersSubMenuID + CASE 3 + 'Export As menu item in File menu + idectxmenuX = xx + w + 3 + idectxmenuY = yy + r + 4 + parentMenu = m + m = FileMenuExportAsSubMenuID END SELECT IdeMakeEditMenu @@ -4769,6 +4792,9 @@ FUNCTION ide2 (ignore) CASE "#Line Numbers" idecontextualmenu = 2 GOTO showmenu + CASE "#Export As..." + idecontextualmenu = 3 + GOTO showmenu END SELECT ELSE m = m + 1: r = 1 @@ -5589,6 +5615,32 @@ FUNCTION ide2 (ignore) END IF END IF + IF menu$(m, s) = "#Export As... " + CHR$(16) THEN + idecontextualmenu = 3 + GOTO showmenu + END IF + + IF menu$(m, s) = "#Hypertext document (.htm)" THEN + PCOPY 2, 0 + ExportCodeAs "html" + PCOPY 3, 0: SCREEN , , 3, 0 + GOTO ideloop + END IF + + IF menu$(m, s) = "#Rich Text document (.rtf)" THEN + PCOPY 2, 0 + ExportCodeAs "rich" + PCOPY 3, 0: SCREEN , , 3, 0 + GOTO ideloop + END IF + + IF menu$(m, s) = "#Wiki prepared sample (.txt)" THEN + PCOPY 2, 0 + ExportCodeAs "wiki" + PCOPY 3, 0: SCREEN , , 3, 0 + GOTO ideloop + END IF + IF menu$(m, s) = "Compiler #Warnings... Ctrl+W" THEN PCOPY 2, 0 retval = idewarningbox @@ -6533,7 +6585,9 @@ FUNCTION ide2 (ignore) IF idecompiling = 1 THEN _PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..." + menu$(1, FileMenuExportAs) = "~#Export As... " + CHR$(16) ELSE + IF ideautolayout <> 0 THEN menu$(1, FileMenuExportAs) = "#Export As... " + CHR$(16) IF idefocusline THEN _PRINTSTRING (2, idewy - 3), STRING$(3, 250) '"..." ELSE @@ -18211,6 +18265,10 @@ SUB IdeMakeFileMenu menuDesc$(m, i - 1) = "Writes current program to a file on disk" menu$(m, i) = "Save #As...": i = i + 1 menuDesc$(m, i - 1) = "Saves current program with specified name" + menu$(m, i) = "-": i = i + 1 + FileMenuExportAs = i + menu$(m, i) = "~#Export As... " + CHR$(16): i = i + 1 + menuDesc$(m, i - 1) = "Export current program into various formats" fh = FREEFILE OPEN ".\internal\temp\recent.bin" FOR BINARY AS #fh: a$ = SPACE$(LOF(fh)): GET #fh, , a$ a$ = RIGHT$(a$, LEN(a$) - 2) @@ -20307,3 +20365,559 @@ Function OpenFile$ (IdeOpenFile as string)'load routine copied/pasted from the o IdeAddRecent idepath$ + idepathsep$ + ideprogname$ IdeImportBookmarks idepath$ + idepathsep$ + ideprogname$ end sub + +SUB ExportCodeAs (docFormat$) + ' Get the current source code, convert it to the desired document format and + ' then write the result into a file (program name or "Untitled" + extension) + ' The exported code is highlighted according to the internal keyword lists + ' and the keywords are linked to its respective Wiki pages. Also the current + ' color theme is utilized for HTML and Rich Text documents, the Wiki however + ' has its own fixed blue theme. + '---------- + pNam$ = ideprogname$: IF pNam$ = "" THEN pNam$ = "Untitled.bas" + SELECT CASE LCASE$(docFormat$) + CASE "html": ext$ = ".htm" + CASE "rich": ext$ = ".rtf" + CASE "wiki": ext$ = ".txt" + CASE ELSE: ext$ = "" + END SELECT + IF _FILEEXISTS(idepath$ + idepathsep$ + pNam$ + ext$) THEN + IF ideyesnobox$("Export As...", "Overwrite file " + pNam$ + ext$) = "N" THEN EXIT SUB + END IF + GOSUB GetThemeColors + cEol$ = CHR$(10) ' '=> line break char(s) + IF INSTR(_OS$, "[LINUX]") = 0 THEN cEol$ = CHR$(13) + cEol$ + '------------------------------ + PCOPY 3, 2: SCREEN , , 3, 0 + sTxt$ = "" ' '=> source code text + FOR i& = 1 TO iden + sTxt$ = sTxt$ + idegetline(i&) + cEol$ + perc$ = str2$(INT(30 / iden * i&)) + IdeInfo = CHR$(0) + STRING$(3 - LEN(perc$), 32) + perc$ + "% exported..." + UpdateIdeInfo + NEXT i& + sLen& = LEN(sTxt$) ' '=> source code length + sPos& = 1 ' '=> source code read position + eTxt$ = SPACE$(10000000) '=> export text buffer + ePos& = 1 ' '=> export text buffer write position + '---------- + post% = 0 ''=> GOSUB argument = 0/-1 (close pre current / post current char) + what$ = "" '=> GOSUB argument = command descriptor + '---------- + co% = 0 '=> comment processing + le% = 0 '=> legacy metacommand processing + me% = 0 '=> QB64 metacommand processing + kw% = 0 '=> keyword processing + nu% = 0 '=> literal number processing + qu% = 0 '=> quote (literal string) processing + '---------- + op% = 0 '=> simply link to OPEN page + ma$ = "@_ARCCOT@_ARCCSC@_ARCSEC@_COT@_COTH@_COSH@_CSC@_CSCH@_SEC@_SECH@_SINH@_TANH@" 'derived math functions + fu% = 0 '=> Wiki page +(function) check required + fu$ = "@_AUTODISPLAY@_BLEND@_BLINK@_CAPSLOCK@_CLEARCOLOR@_CLIPBOARD$@_CLIPBOARDIMAGE@_CONTROLCHR@_DEST@_DISPLAY@_EXIT@_FONT@_FULLSCREEN@_MAPUNICODE@_MEM@_MEMGET@_MESSAGEBOX@_NUMLOCK@_OFFSET@_PALETTECOLOR@_PRINTMODE@_RESIZE@_SCREENICON@_SCROLLLOCK@_SMOOTH@_SOURCE@_WIDTH@ASC@MID$@PLAY@SCREEN@SEEK@SHELL@TIMER@" + bo% = 0 '=> Wiki page +(boolean) check required + bo$ = "@AND@OR@XOR@" + '---------- + np% = 0 ''=> $NOPREFIX indicator + pc% = 0 ''=> pre-compiler indicator + ml% = 0 ''=> meta line indicator + cu% = 0 ''=> custom keyword indicator + lb% = 0 ''=> line break indicator + nl% = -1 '=> new line indicator + nt% = -1 '=> new token indicator + '---------- + nc% = 0 '=> paranthesis nesting counter + in% = 0 '=> ignore next keyword + sk% = 0 '=> skip copying current char + '---------- + GOSUB OpenCodeBlock + WHILE sPos& <= sLen& + perc$ = str2$(30 + INT(70 / sLen& * sPos&)) + IdeInfo = CHR$(0) + STRING$(3 - LEN(perc$), 32) + perc$ + "% exported..." + UpdateIdeInfo + '---------- + curr% = ASC(sTxt$, sPos&) '=> current char's ASCII value + SELECT CASE curr% ' '=> general parsing and handling + CASE 10, 13 'line feed + IF NOT lb% THEN + IF me% THEN + GOSUB VerifyKeyword: GOSUB WriteLink: me% = 0: le% = 0 + IF UCASE$(me$) = "$NOPREFIX" THEN np% = -1 + END IF + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0 + END IF + IF co% THEN post% = 0: what$ = "co": GOSUB CloseText: co% = 0 + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + IF sPos& > 1 THEN + IF ASC(sTxt$, sPos& - 1) <> 95 THEN op% = 0: fu% = 0: bo% = 0 + ELSE + op% = 0: fu% = 0: bo% = 0 + END IF + GOSUB EndLineOps + IF curr% = 13 THEN lb% = -1 + END IF + IF curr% = 10 THEN pc% = 0: ml% = 0: lb% = 0: nl% = -1: nt% = -1 + CASE 9, 32 'space + IF me% THEN + GOSUB VerifyKeyword: GOSUB WriteLink: me% = 0: le% = 0 + SELECT CASE UCASE$(me$) + CASE "$IF", "$ELSEIF", "$END": pc% = -1 + END SELECT + END IF + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0: IF in% THEN sk% = -1 + SELECT CASE UCASE$(kw$) + CASE "REM": IF NOT (co% OR qu%) THEN co% = -1: what$ = "co": GOSUB OpenText + CASE "OPEN": op% = -1 + CASE "IF", "ELSEIF", "UNTIL", "WHILE": fu% = -1: bo% = -1 + CASE "THEN": fu% = 0: bo% = 0 + CASE ELSE + FOR i& = 1 TO idn + IF ids(i&).subfunc = 2 AND ids(i&).args > 0 THEN + id$ = RTRIM$(ids(i&).n): uw$ = UCASE$(kw$) + IF (id$ = uw$) OR (np% AND id$ = "_" + uw$) THEN fu% = -2: EXIT FOR + END IF + NEXT i& + END SELECT + END IF + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + nt% = -1 + CASE 34 '" + IF NOT (co% OR qu%) THEN + qu% = -1: what$ = "qu": GOSUB OpenText + ELSEIF qu% THEN + post% = -1: what$ = "qu": GOSUB CloseText: qu% = 0 + END IF + IF NOT sk% THEN GOSUB EscapeChar 'html + CASE 36 '$ + IF nl% OR le% THEN ml% = -1: me% = -1: me$ = "": nt% = 0 + CASE 38 '& + IF nt% AND NOT (co% OR qu%) THEN + IF sPos& + 1 <= sLen& THEN + IF INSTR("BHO", CHR$(ASC(sTxt$, sPos& + 1))) > 0 THEN + nu% = -1: what$ = "nu": GOSUB OpenText: nt% = 0 + END IF + END IF + END IF + IF NOT (me% OR kw%) THEN GOSUB EscapeChar 'html + CASE 39 '' + IF nl% THEN + IF sPos& + 1 <= sLen& THEN + IF ASC(sTxt$, sPos& + 1) = 36 THEN le% = -1: nt% = 0 + END IF + END IF + IF NOT (co% OR qu%) THEN co% = -1: what$ = "co": GOSUB OpenText + CASE 40, 41 '( ) + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0 + END IF + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + IF NOT (co% OR qu%) THEN + IF curr% = 40 THEN nc% = nc% + 1: ELSE nc% = nc% - 1 + END IF + IF NOT (co% OR qu% OR (fu% < -1) OR bo%) THEN + IF nc% > 0 THEN fu% = -1: ELSE fu% = 0 + END IF + nt% = -1 + CASE 42 TO 44, 47, 59 TO 62, 92, 94 '* + , / ; < = > \ ^ + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0 + END IF + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + IF curr% = 61 AND NOT (co% OR qu% OR (fu% < -1) OR bo%) THEN fu% = -3 + IF curr% = 60 OR curr% = 62 OR curr% = 92 THEN GOSUB EscapeChar 'html, rtf + nt% = -1 + CASE 45 '- + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0 + END IF + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + nt% = -1 + IF NOT (co% OR qu%) THEN + SELECT CASE ASC(sTxt$, sPos& - 1) + CASE 9, 32, 40, 42 TO 45, 47, 59 TO 63, 92, 94 'after this it may be a neg. sign + IF sPos& + 1 <= sLen& THEN + IF INSTR(".0123456789", CHR$(ASC(sTxt$, sPos& + 1))) > 0 THEN + nu% = -1: what$ = "nu": GOSUB OpenText: nt% = 0 + END IF + END IF + END SELECT + END IF + CASE 46 '. + IF nt% AND NOT (co% OR qu%) THEN + IF sPos& + 1 <= sLen& THEN + IF INSTR("0123456789", CHR$(ASC(sTxt$, sPos& + 1))) > 0 THEN + nu% = -1: what$ = "nu": GOSUB OpenText: nt% = 0 + END IF + END IF + END IF + CASE 48 TO 57 '0-9 + IF nt% AND NOT (co% OR qu%) THEN nu% = -1: what$ = "nu": GOSUB OpenText: nt% = 0 + CASE 58 ': + IF me% THEN GOSUB VerifyKeyword: GOSUB WriteLink: me% = 0: le% = 0 + IF kw% THEN + IF NOT in% THEN GOSUB VerifyKeyword: GOSUB WriteLink: ELSE kw$ = "": in% = 0 + kw% = 0 + END IF + IF nu% THEN post% = 0: what$ = "nu": GOSUB CloseText: nu% = 0 + IF NOT (co% OR qu%) THEN op% = 0: fu% = 0: bo% = 0 + nt% = -1 + CASE 123, 125 '{ } + GOSUB EscapeChar 'rtf + CASE 65 TO 90, 97 TO 122 'A-Z a-z + IF nt% AND NOT (co% OR qu%) THEN kw% = -1: kw$ = "": nt% = 0 + IF nl% AND UCASE$(MID$(sTxt$, sPos&, 5)) = "REM $" THEN le% = -1 + CASE 95 '_ + IF nt% AND NOT (co% OR qu%) THEN + IF sPos& + 1 <= sLen& THEN + IF ASC(sTxt$, sPos& + 1) <> 13 AND ASC(sTxt$, sPos& + 1) <> 10 THEN + kw% = -1: kw$ = "": nt% = 0 + END IF + END IF + END IF + CASE IS > 127 'ext. ASCII + GOSUB EscapeChar 'html, rtf, wiki + CASE ELSE 'control, non-semantics, type suffix w/o further meaning + nt% = 0 + END SELECT + SELECT CASE curr% ' '=> keyword accumulation + CASE 33, 35 TO 38, 46, 48 TO 57, 65 TO 90, 95 TO 122, 126 + IF me% THEN me$ = me$ + CHR$(curr%): sk% = -1 + IF kw% THEN kw$ = kw$ + CHR$(curr%): sk% = -1 + END SELECT + IF curr% <> 9 AND curr% <> 10 AND curr% <> 32 THEN nl% = 0 + IF NOT sk% THEN ASC(eTxt$, ePos&) = curr%: ePos& = ePos& + 1 + sk% = 0: sPos& = sPos& + 1 + WEND + GOSUB CloseCodeBlock + '---------- + ideerror = 7 + OPEN idepath$ + idepathsep$ + pNam$ + ext$ FOR OUTPUT AS #151 + ideerror = 1 + PRINT #151, LEFT$(eTxt$, ePos& - 1); + CLOSE #151 + PCOPY 2, 3 + EXIT SUB + '------------------------------ + OpenCodeBlock: + SELECT CASE LCASE$(docFormat$) + CASE "html": tmp$ = "" + AnsiTextToUtf8Text$(pNam$) + "
"
+        CASE "rich": tmp$ = "{\rtf1\ansi\deff0{\fonttbl{\f0 Courier New;}}{\colortbl " + rtc$ + "}\pard\f0\fs32\cbpat6\paperh23811\paperw16838\margl142\margr142\margt142\margb142"
+        CASE "wiki": tmp$ = "{{CodeStart}}"
+        CASE ELSE: RETURN
+    END SELECT
+    MID$(eTxt$, ePos&, LEN(tmp$)) = tmp$: ePos& = ePos& + LEN(tmp$)
+    MID$(eTxt$, ePos&, LEN(cEol$)) = cEol$: ePos& = ePos& + LEN(cEol$)
+    RETURN
+    '----------
+    CloseCodeBlock:
+    SELECT CASE LCASE$(docFormat$)
+        CASE "html": tmp$ = "
" + CASE "rich": tmp$ = "}" + CASE "wiki": tmp$ = "{{CodeEnd}}" + CASE ELSE: RETURN + END SELECT + MID$(eTxt$, ePos&, LEN(tmp$)) = tmp$: ePos& = ePos& + LEN(tmp$) + MID$(eTxt$, ePos&, LEN(cEol$)) = cEol$: ePos& = ePos& + LEN(cEol$) + RETURN + '---------- + OpenText: + SELECT CASE LCASE$(docFormat$) + CASE "html" + SELECT CASE LCASE$(what$) + CASE "co": tmp$ = "" + CASE "nu": tmp$ = "" + CASE "qu": tmp$ = "" + CASE ELSE: RETURN + END SELECT + CASE "rich" + SELECT CASE LCASE$(what$) + CASE "co": tmp$ = "\cf1 " + CASE "nu": tmp$ = "\cf4 " + CASE "qu": tmp$ = "\cf5 " + CASE ELSE: RETURN + END SELECT + CASE "wiki" + SELECT CASE LCASE$(what$) + CASE "co", "qu": tmp$ = "{{Text|" + CASE "nu": tmp$ = "{{Text|" + CASE ELSE: RETURN + END SELECT + CASE ELSE: RETURN + END SELECT + MID$(eTxt$, ePos&, LEN(tmp$)) = tmp$: ePos& = ePos& + LEN(tmp$) + RETURN + '---------- + CloseText: + SELECT CASE LCASE$(docFormat$) + CASE "html" + SELECT CASE LCASE$(what$) + CASE "co", "nu", "qu": tmp$ = "" + CASE ELSE: RETURN + END SELECT + CASE "rich" + SELECT CASE LCASE$(what$) + CASE "co", "nu", "qu": tmp$ = "\cf0 " + CASE ELSE: RETURN + END SELECT + CASE "wiki" + SELECT CASE LCASE$(what$) + CASE "co": tmp$ = "|#919191}}" + CASE "nu": tmp$ = "|#F580B1}}" + CASE "qu": tmp$ = "|#FFB100}}" + CASE ELSE: RETURN + END SELECT + CASE ELSE: RETURN + END SELECT + IF post% THEN + sk% = 0: GOSUB EscapeChar + IF NOT sk% THEN ASC(eTxt$, ePos&) = curr%: ePos& = ePos& + 1: sk% = -1 + END IF + MID$(eTxt$, ePos&, LEN(tmp$)) = tmp$: ePos& = ePos& + LEN(tmp$) + RETURN + '---------- + VerifyKeyword: + IF me% THEN veri$ = me$: ELSE veri$ = kw$ + IF ASC(veri$, 1) <> 95 THEN flp% = 1: ELSE flp% = 2 + IF (ASC(veri$, flp%) < 91 OR MID$(veri$, flp%, 2) = "gl") AND INSTR(listOfKeywords$, "@" + UCASE$(veri$) + "@") > 0 THEN + IF me% AND le% THEN + IF INSTR("$DYNAMIC$INCLUDE$STATIC", UCASE$(veri$)) = 0 THEN me$ = "" + ELSEIF me% AND NOT le% THEN + IF INSTR("$DYNAMIC$INCLUDE$STATIC", UCASE$(veri$)) > 0 THEN me$ = "" + END IF + IF pc% AND (UCASE$(veri$) = "IF" OR UCASE$(veri$) = "THEN") THEN me$ = veri$ + ELSEIF np% AND kw% THEN + IF ASC(veri$, 1) > 90 OR INSTR(listOfKeywords$, "@_" + UCASE$(veri$) + "@") = 0 THEN kw$ = "" + ELSEIF NOT ml% AND INSTR(listOfCustomKeywords$, "@" + UCASE$(removesymbol2$(veri$)) + "@") > 0 THEN + cu% = -1 + ELSEIF pc% AND INSTR(UserDefineList$, "@" + UCASE$(veri$) + "@") > 0 THEN + cu% = -1 + ELSE + IF me% THEN me$ = "": ELSE kw$ = "" + END IF + RETURN + '---------- + FindWikiPage: + IF me% THEN page$ = UCASE$(me$): ELSE page$ = UCASE$(kw$) 'Wiki pages are all caps + IF op% THEN + SELECT CASE page$ + CASE "ACCESS", "LOCK", "SHARED", "READ", "WRITE": page$ = "OPEN#File_ACCESS_and_LOCK_Permissions" + CASE "FOR", "OUTPUT", "APPEND", "INPUT", "BINARY", "RANDOM": page$ = "OPEN#File_Access_Modes" + CASE ELSE: page$ = "OPEN" + END SELECT + ELSEIF fu% AND ((INSTR(fu$, "@" + page$ + "@") > 0) OR (np% AND INSTR(fu$, "@_" + page$ + "@") > 0)) THEN + IF page$ = "SHELL" THEN page$ = page$ + " (QB64 function)": ELSE page$ = page$ + " (function)" + ELSEIF bo% AND INSTR(bo$, "@" + page$ + "@") > 0 THEN 'np% check omitted (legacy words only) + page$ = page$ + " (boolean)" + ELSEIF ((INSTR(ma$, "@" + page$ + "@") > 0) OR (np% AND INSTR(ma$, "@_" + page$ + "@") > 0)) THEN + page$ = "Mathematical Operations#Derived_Mathematical_Functions" + ELSE + la$ = LTRIM$(StrReplace$(MID$(sTxt$, sPos&, 100), CHR$(9), " ")) + SELECT EVERYCASE page$ + CASE "CALL": IF UCASE$(LEFT$(la$, 8)) = "ABSOLUTE" THEN kw$ = kw$ + " " + LEFT$(la$, 8): page$ = "CALL ABSOLUTE": in% = -1 + CASE "DECLARE": IF UCASE$(LEFT$(la$, 7)) = "LIBRARY" THEN kw$ = kw$ + " " + LEFT$(la$, 7): page$ = "DECLARE LIBRARY": in% = -1 + CASE "DEF": IF UCASE$(LEFT$(la$, 3)) = "SEG" THEN kw$ = kw$ + " " + LEFT$(la$, 3): page$ = "DEF SEG": in% = -1 + CASE "DO" + IF UCASE$(LEFT$(la$, 5)) = "WHILE" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "DO...LOOP": fu% = -1: bo% = -1: in% = -1 + IF UCASE$(LEFT$(la$, 5)) = "UNTIL" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "DO...LOOP": fu% = -1: bo% = -1: in% = -1 + CASE "END" + IF UCASE$(LEFT$(la$, 7)) = "DECLARE" THEN kw$ = kw$ + " " + LEFT$(la$, 7): page$ = "END DECLARE": in% = -1 + IF UCASE$(LEFT$(la$, 8)) = "FUNCTION" THEN kw$ = kw$ + " " + LEFT$(la$, 8): page$ = "END FUNCTION": in% = -1 + IF UCASE$(LEFT$(la$, 2)) = "IF" THEN kw$ = kw$ + " " + LEFT$(la$, 2): page$ = "END IF": in% = -1 + IF UCASE$(LEFT$(la$, 6)) = "SELECT" THEN kw$ = kw$ + " " + LEFT$(la$, 6): page$ = "END SELECT": in% = -1 + IF UCASE$(LEFT$(la$, 3)) = "SUB" THEN kw$ = kw$ + " " + LEFT$(la$, 3): page$ = "END SUB": in% = -1 + IF UCASE$(LEFT$(la$, 4)) = "TYPE" THEN kw$ = kw$ + " " + LEFT$(la$, 4): page$ = "END TYPE": in% = -1 + CASE "EXIT" + IF UCASE$(LEFT$(la$, 4)) = "CASE" THEN kw$ = kw$ + " " + LEFT$(la$, 4): page$ = "EXIT CASE": in% = -1 + IF UCASE$(LEFT$(la$, 2)) = "DO" THEN kw$ = kw$ + " " + LEFT$(la$, 2): page$ = "EXIT DO": in% = -1 + IF UCASE$(LEFT$(la$, 3)) = "FOR" THEN kw$ = kw$ + " " + LEFT$(la$, 3): page$ = "EXIT FOR": in% = -1 + IF UCASE$(LEFT$(la$, 8)) = "FUNCTION" THEN kw$ = kw$ + " " + LEFT$(la$, 8): page$ = "EXIT FUNCTION": in% = -1 + IF UCASE$(LEFT$(la$, 6)) = "SELECT" THEN kw$ = kw$ + " " + LEFT$(la$, 6): page$ = "EXIT SELECT": in% = -1 + IF UCASE$(LEFT$(la$, 3)) = "SUB" THEN kw$ = kw$ + " " + LEFT$(la$, 3): page$ = "EXIT SUB": in% = -1 + IF UCASE$(LEFT$(la$, 5)) = "WHILE" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "EXIT WHILE": in% = -1 + CASE "GET", "PUT": IF LEFT$(la$, 1) <> "#" THEN page$ = page$ + " (general)" + CASE "KEY": IF UCASE$(LEFT$(la$, 4)) = "LIST" THEN kw$ = kw$ + " " + LEFT$(la$, 4): page$ = "KEY LIST": in% = -1 + CASE "LPRINT": IF UCASE$(LEFT$(la$, 5)) = "USING" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "LPRINT USING": in% = -1 + CASE "LINE" + IF UCASE$(LEFT$(la$, 5)) = "INPUT" THEN + kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "LINE INPUT": in% = -1 + IF LEFT$(LTRIM$(MID$(la$, 6)), 1) = "#" THEN page$ = page$ + " (file statement)" + END IF + CASE "LOOP" + IF UCASE$(LEFT$(la$, 5)) = "WHILE" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "DO...LOOP": fu% = -1: bo% = -1: in% = -1 + IF UCASE$(LEFT$(la$, 5)) = "UNTIL" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "DO...LOOP": fu% = -1: bo% = -1: in% = -1 + CASE "ON" + IF UCASE$(LEFT$(la$, 5)) = "ERROR" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "ON ERROR": in% = -1 + IF UCASE$(LEFT$(la$, 3)) = "KEY" THEN kw$ = kw$ + " " + LEFT$(la$, 3): page$ = "ON KEY": in% = -1 + IF UCASE$(LEFT$(la$, 5)) = "STRIG" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "ON STRIG": in% = -1 + IF UCASE$(LEFT$(la$, 5)) = "TIMER" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "ON TIMER": in% = -1 + CASE "OPTION": IF UCASE$(LEFT$(la$, 4)) = "BASE" THEN kw$ = kw$ + " " + LEFT$(la$, 4): page$ = "OPTION BASE": in% = -1 + CASE "PALETTE": IF UCASE$(LEFT$(la$, 5)) = "USING" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "PALETTE USING": in% = -1 + CASE "PRINT" + IF UCASE$(LEFT$(la$, 5)) = "USING" THEN + kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "PRINT USING": in% = -1 + IF LEFT$(LTRIM$(MID$(la$, 6)), 1) = "#" THEN page$ = page$ + " (file statement)" + END IF + CASE "RANDOMIZE": IF UCASE$(LEFT$(la$, 5)) = "USING" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "RANDOMIZE USING": in% = -1 + CASE "SELECT" + IF UCASE$(LEFT$(la$, 4)) = "CASE" THEN kw$ = kw$ + " " + LEFT$(la$, 4): page$ = "SELECT CASE": in% = -1 + IF UCASE$(LEFT$(la$, 9)) = "EVERYCASE" THEN kw$ = kw$ + " " + LEFT$(la$, 9): page$ = "SELECT CASE": in% = -1 + CASE "VIEW": IF UCASE$(LEFT$(la$, 5)) = "PRINT" THEN kw$ = kw$ + " " + LEFT$(la$, 5): page$ = "VIEW PRINT": in% = -1 + CASE "INPUT", "PRINT", "WRITE": IF LEFT$(la$, 1) = "#" THEN page$ = page$ + " (file statement)" + END SELECT + END IF + RETURN + '---------- + WriteLink: + IF (me% AND me$ = "") OR (kw% AND kw$ = "") GOTO UnknownNoLinkNoColor + IF cu% GOTO CustomNoLink + GOSUB FindWikiPage + IF me% AND le% AND co% THEN post% = 0: what$ = "co": GOSUB CloseText: co% = 0 + IF me% OR pc% THEN lnk$ = me$: tmp$ = "{{Cm|": lkc$ = mec$: rtc$ = "\cf2": ELSE lnk$ = kw$: tmp$ = "{{Cl|": lkc$ = kwc$: rtc$ = "\cf3" + pal% = LEN(page$): lkl% = LEN(lnk$) + SELECT CASE LCASE$(docFormat$) + CASE "html" + MID$(eTxt$, ePos&, pal% + lkl% + 111) = "" + lnk$ + "" + ePos& = ePos& + pal% + lkl% + 111 + CASE "rich" + MID$(eTxt$, ePos&, pal% + lkl% + 108) = "{\field{\*\fldinst HYPERLINK " + CHR$(34) + "https://qb64phoenix.com/qb64wiki/index.php?title=" + page$ + CHR$(34) + "}{\fldrslt{" + rtc$ + "\ul0 " + lnk$ + "}}}\cf0 " + ePos& = ePos& + pal% + lkl% + 108 + CASE "wiki" + IF UCASE$(page$) = UCASE$(lnk$) THEN + MID$(eTxt$, ePos&, lkl% + 7) = tmp$ + lnk$ + "}}" + ePos& = ePos& + lkl% + 7 + ELSE + MID$(eTxt$, ePos&, pal% + lkl% + 8) = tmp$ + page$ + "|" + lnk$ + "}}" + ePos& = ePos& + pal% + lkl% + 8 + END IF + CASE ELSE: RETURN + END SELECT + RETURN + '--- + CustomNoLink: + cu% = 0: kwl% = LEN(kw$) + SELECT CASE LCASE$(docFormat$) + CASE "html" + kw$ = StrReplace$(kw$, "&", "&"): kwl% = LEN(kw$) + MID$(eTxt$, ePos&, kwl% + 37) = "" + kw$ + "" + ePos& = ePos& + kwl% + 37 + CASE "rich" + MID$(eTxt$, ePos&, kwl% + 10) = "\cf2 " + kw$ + "\cf0 " + ePos& = ePos& + kwl% + 10 + CASE "wiki" + MID$(eTxt$, ePos&, kwl% + 17) = "{{Text|" + kw$ + "|#55FF55}}" + ePos& = ePos& + kwl% + 17 + CASE ELSE: RETURN + END SELECT + RETURN + '--- + UnknownNoLinkNoColor: + IF LCASE$(docFormat$) = "html" THEN veri$ = StrReplace$(veri$, "&", "&") + MID$(eTxt$, ePos&, LEN(veri$)) = veri$: ePos& = ePos& + LEN(veri$): veri$ = "" + RETURN + '---------- + EscapeChar: + SELECT CASE LCASE$(docFormat$) + CASE "html" + SELECT CASE curr% + CASE 34: ech$ = """: sk% = -1 + CASE 38: ech$ = "&": sk% = -1 + CASE 60: ech$ = "<": sk% = -1 + CASE 62: ech$ = ">": sk% = -1 + CASE IS > 127 + uni& = _MAPUNICODE(curr%) + IF uni& = 0 THEN uni& = 65533 'replacement character + ech$ = UnicodeToUtf8Char$(uni&): sk% = -1 + CASE ELSE: RETURN + END SELECT + CASE "rich" + SELECT CASE curr% + CASE 92, 123, 125: ech$ = "\" + CASE IS > 127 + uni& = _MAPUNICODE(curr%) + IF uni& = 0 THEN uni& = 65533 'replacement character + ech$ = "\u" + LTRIM$(STR$(uni&)) + "\'bf": sk% = -1 + CASE ELSE: RETURN + END SELECT + CASE "wiki" ' 'Keeps the original encoding, so Wiki examples can be copied + SELECT CASE curr% 'back to the IDE. However, chars appear wrong in the Wiki. + CASE IS > 127: ech$ = "&#" + LTRIM$(STR$(curr%)) + ";": sk% = -1 + CASE ELSE: RETURN + END SELECT + CASE ELSE: RETURN + END SELECT + MID$(eTxt$, ePos&, LEN(ech$)) = ech$: ePos& = ePos& + LEN(ech$) + RETURN + '---------- + EndLineOps: + SELECT CASE LCASE$(docFormat$) + CASE "rich": tmp$ = "\par" + CASE ELSE: RETURN + END SELECT + MID$(eTxt$, ePos&, LEN(tmp$)) = tmp$: ePos& = ePos& + LEN(tmp$) + RETURN + '---------- + GetThemeColors: + txc$ = "#" + RIGHT$(HEX$(IDETextColor), 6) + rtc$ = "\red" + LTRIM$(STR$(_RED32(IDETextColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDETextColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDETextColor))) + ";" + coc$ = "#" + RIGHT$(HEX$(IDECommentColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDECommentColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDECommentColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDECommentColor))) + ";" + mec$ = "#" + RIGHT$(HEX$(IDEMetaCommandColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDEMetaCommandColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDEMetaCommandColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDEMetaCommandColor))) + ";" + kwc$ = "#" + RIGHT$(HEX$(IDEKeywordColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDEKeywordColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDEKeywordColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDEKeywordColor))) + ";" + nuc$ = "#" + RIGHT$(HEX$(IDENumbersColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDENumbersColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDENumbersColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDENumbersColor))) + ";" + quc$ = "#" + RIGHT$(HEX$(IDEQuoteColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDEQuoteColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDEQuoteColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDEQuoteColor))) + ";" + bgc$ = "#" + RIGHT$(HEX$(IDEBackgroundColor), 6) + rtc$ = rtc$ + "\red" + LTRIM$(STR$(_RED32(IDEBackgroundColor))) + "\green" + LTRIM$(STR$(_GREEN32(IDEBackgroundColor))) + "\blue" + LTRIM$(STR$(_BLUE32(IDEBackgroundColor))) + ";" + RETURN +END SUB + +FUNCTION UnicodeToUtf8Char$ (unicode&) + '--- UTF-8 encoding --- + IF unicode& < 128 THEN + '--- standard ASCII (0-127) goes as is --- + UnicodeToUtf8Char$ = CHR$(unicode&) + ELSE + '--- encode the Unicode into UTF-8 notation --- + utf$ = "": uc& = unicode& 'avoid argument side effect + first% = &B10000000: remain% = 63 + DO + first% = &B10000000 OR (first% \ 2): remain% = (remain% \ 2) + conti% = &B10000000 OR (uc& AND &B00111111): uc& = uc& \ 64 + utf$ = CHR$(conti%) + utf$ + IF uc& <= remain% THEN + first% = (first% OR uc&): uc& = 0 + END IF + LOOP UNTIL uc& = 0 + UnicodeToUtf8Char$ = CHR$(first%) + utf$ + END IF +END FUNCTION + +FUNCTION AnsiTextToUtf8Text$ (text$) + utf$ = "" + FOR chi& = 1 TO LEN(text$) + '--- get ANSI char code --- + ascii% = ASC(text$, chi&) + IF ascii% > 127 THEN + '--- read Unicode from active codepage --- + unicode& = _MAPUNICODE(ascii%) + '--- convert and add UTF-8 char --- + IF unicode& = 0 THEN unicode& = 65533 'replacement character + utf$ = utf$ + UnicodeToUtf8Char$(unicode&) + ELSE + '--- standard ASCII (0-127) goes as is --- + utf$ = utf$ + CHR$(ascii%) + END IF + NEXT chi& + AnsiTextToUtf8Text$ = utf$ +END FUNCTION +