From deb80bdec63ff55be96fc8f83c44100b002a30bb Mon Sep 17 00:00:00 2001 From: FellippeHeitor Date: Mon, 4 Jan 2016 20:41:47 -0200 Subject: [PATCH] Improvements to the SUBs dialog. - Add sorting, using Steve's sorting routine. - Add a visual indicator (*) that a procedure is external. --- source/global/IDEsettings.bas | 14 ++ source/ide/ide_global.bas | 2 +- source/ide/ide_methods.bas | 433 +++++++++++++++++++++++++++++++++- 3 files changed, 437 insertions(+), 12 deletions(-) diff --git a/source/global/IDEsettings.bas b/source/global/IDEsettings.bas index 771ccaffb..bd5c5e6e7 100644 --- a/source/global/IDEsettings.bas +++ b/source/global/IDEsettings.bas @@ -193,6 +193,20 @@ IF LoadedIDESettings = 0 THEN ideindentsubs = 0 end if + result = ReadConfigSetting("IDE_SortSUBs", value$) + idesortsubs = VAL(value$) + IF UCASE$(value$) = "TRUE" OR idesortsubs <> 0 THEN + idesortsubs = 1 + elseif result = 0 then + WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "FALSE" + idesortsubs = 0 + ELSEIF UCASE$(value$) <> "FALSE" AND value$ <> "0" THEN + WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "TRUE" + idesortsubs = 1 + else + idesortsubs = 0 + end if + result = ReadConfigSetting("IDE_IndentSize", value$) ideautoindentsize = VAL(value$) if ideautoindentsize < 1 OR ideautoindentsize > 64 then diff --git a/source/ide/ide_global.bas b/source/ide/ide_global.bas index 6e1ac3ab2..f9c5a3ebc 100644 --- a/source/ide/ide_global.bas +++ b/source/ide/ide_global.bas @@ -189,7 +189,7 @@ DIM SHARED menus AS INTEGER DIM SHARED menubar$ DIM SHARED ideundocombo, ideundocombochr, idenoundo, idemergeundo DIM SHARED idealthighlight, ideentermenu -DIM SHARED ideautolayout, ideautoindent, ideautoindentsize, ideindentsubs, idebackupsize +DIM SHARED ideautolayout, ideautoindent, ideautoindentsize, ideindentsubs, idebackupsize, idesortsubs DIM SHARED idewx, idewy, idecustomfont, idecustomfontfile$, idecustomfontheight, idecustomfonthandle DIM SHARED iderunmode 'IDE MODULE SECTION END: shared data & definitions diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index c2ee6e75b..ad120ce62 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -6439,20 +6439,33 @@ IF x <= LEN(a$) THEN a2$ = CHR$(ASC(a$, x)) END IF a2$ = UCASE$(a2$) 'a2$ now holds the word or character at current cursor position + if len(a2$) > 1 then + do until alphanumeric(asc(right$(a2$, 1))) + a2$ = left$(a2$, len(a2$) - 1) 'removes sigil, if any + loop + end if END IF '-------- init -------- ly$ = MKL$(1) +lySorted$ = ly$ CurrentlyViewingWhichSUBFUNC = 1 PreferCurrentCursorSUBFUNC = 0 +InsideDECLARE = 0 +FoundExternalSUBFUNC = 0 l$ = ideprogname$ IF l$ = "" THEN l$ = "Untitled" + tempfolderindexstr$ +lSorted$ = l$ + +TotalSUBs = 0 FOR y = 1 TO iden a$ = idegetline(y) a$ = LTRIM$(RTRIM$(a$)) sf = 0 nca$ = UCASE$(a$) + IF LEFT$(nca$, 8) = "DECLARE " and INSTR(nca$, " LIBRARY") > 0 THEN InsideDECLARE = -1 + IF LEFT$(nca$, 11) = "END DECLARE" THEN InsideDECLARE = 0 IF LEFT$(nca$, 4) = "SUB " THEN sf = 1: sf$ = "SUB " IF LEFT$(nca$, 9) = "FUNCTION " THEN sf = 2: sf$ = "FUNC " IF sf THEN @@ -6463,7 +6476,7 @@ FOR y = 1 TO iden 'Check if the cursor is currently inside this SUB/FUNCTION to position the 'selection properly in the list. - IF idecy >= y THEN + IF idecy >= y AND NOT InsideDECLARE THEN CurrentlyViewingWhichSUBFUNC = (LEN(ly$) / 4) END IF 'End of current SUB/FUNCTION check @@ -6483,10 +6496,6 @@ FOR y = 1 TO iden args$ = "" END IF - 'If the user currently has the cursor over a SUB/FUNC name, let's highlight it - 'instead of the currently in edition, for a quick link functionality: - IF a2$ = UCASE$(n$) THEN PreferCurrentCursorSUBFUNC = (LEN(ly$) / 4) - 'attempt to cleanse n$, just in case there are any comments or other unwanted stuff for CleanseN = 1 to len(n$) select case mid$(n$, CleanseN, 1) @@ -6496,6 +6505,18 @@ FOR y = 1 TO iden end select next + 'If the user currently has the cursor over a SUB/FUNC name, let's highlight it + 'instead of the currently in edition, for a quick link functionality: + n2$ = n$ + if len(n2$) > 1 then + do until alphanumeric(asc(right$(n2$, 1))) + n2$ = left$(n$, len(n2$) - 1) 'removes sigil, if any + loop + end if + IF a2$ = UCASE$(n2$) THEN PreferCurrentCursorSUBFUNC = (LEN(ly$) / 4) + + IF InsideDECLARE = -1 THEN n$ = "*" + n$: FoundExternalSUBFUNC = -1 + IF LEN(n$) <= 20 THEN n$ = n$ + SPACE$(20 - LEN(n$)) ELSE @@ -6508,6 +6529,15 @@ FOR y = 1 TO iden END IF l$ = l$ + sep + chr$(195) + chr$(196) + n$ + " " + sf$ + args$ + 'Populate SortedSubsList() + TotalSUBs = TotalSUBs + 1 + ListItemLength = LEN(n$ + " " + sf$ + args$) + REDIM _PRESERVE SortedSubsList(1 to TotalSUBs) as string * 998 + REDIM _PRESERVE CaseBkpSubsList(1 to TotalSUBs) as string * 998 + CaseBkpSubsList(TotalSUBs) = n$ + " " + sf$ + args$ + SortedSubsList(TotalSUBs) = UCASE$(CaseBkpSubsList(TotalSUBs)) + MID$(CaseBkpSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) + MID$(SortedSubsList(TotalSUBs), 992, 6) = MKL$(y) + MKI$(ListItemLength) END IF NEXT @@ -6516,7 +6546,29 @@ FOR x = LEN(l$) TO 1 STEP -1 IF a$ = chr$(195) THEN MID$(l$, x, 1) = chr$(192): EXIT FOR NEXT +if TotalSUBs > 1 then + DIM m as _MEM + m = _MEM(SortedSubsList()) + Sort m 'Steve's sorting routine + FOR x = 1 to TotalSUBs + ListItemLength = CVI(MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 2, 2)) + lySorted$ = lySorted$ + MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) + for RestoreCaseBkp = 1 to TotalSUBs + IF MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) = MID$(CaseBkpSubsList(RestoreCaseBkp), LEN(CaseBkpSubsList(RestoreCaseBkp)) - 6, 4) THEN + lSorted$ = lSorted$ + sep + chr$(195) + chr$(196) + left$(CaseBkpSubsList(RestoreCaseBkp), ListItemLength) + EXIT FOR + END IF + next + NEXT + FOR x = LEN(lSorted$) TO 1 STEP -1 + a$ = MID$(lSorted$, x, 1) + IF a$ = chr$(195) THEN MID$(lSorted$, x, 1) = chr$(192): EXIT FOR + NEXT + SortedSubsFlag = idesortsubs +else + SortedSubsFlag = 0 'Override idesortsubs if the current program doesn't have more than 1 subprocedure +end if '72,19 i = 0 @@ -6528,10 +6580,29 @@ o(i).y = 1 '68 o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 9 o(i).txt = idenewtxt(l$) -IF PreferCurrentCursorSUBFUNC <> 0 THEN - o(i).sel = PreferCurrentCursorSUBFUNC +IF SortedSubsFlag = 0 THEN + IF PreferCurrentCursorSUBFUNC <> 0 THEN + o(i).sel = PreferCurrentCursorSUBFUNC + ELSE + o(i).sel = CurrentlyViewingWhichSUBFUNC + END IF ELSE - o(i).sel = CurrentlyViewingWhichSUBFUNC + idetxt(o(i).txt) = lSorted$ + IF PreferCurrentCursorSUBFUNC <> 0 THEN + for x = 1 to TotalSUBs + if MID$(ly$, PreferCurrentCursorSUBFUNC * 4 - 3, 4) = MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) THEN + o(i).sel = x + 1 'The sorted list items array doesn't contain the first line (ideprogname$) + EXIT FOR + END IF + NEXT + ELSE + for x = 1 to TotalSUBs + if MID$(ly$, CurrentlyViewingWhichSUBFUNC * 4 - 3, 4) = MID$(SortedSubsList(x), LEN(SortedSubsList(x)) - 6, 4) THEN + o(i).sel = x + 1 'The sorted list items array doesn't contain the first line (ideprogname$) + EXIT FOR + END IF + NEXT + END IF END IF o(i).nam = idenewtxt("Program Items") @@ -6542,6 +6613,16 @@ o(i).y = idewy + idesubwindow - 6 o(i).txt = idenewtxt("#Edit" + sep + "#Cancel") o(i).dft = 1 +If TotalSUBs > 1 then + i = i + 1 + o(i).typ = 4 'check box + o(i).x = idewx - 22 + o(i).y = idewy + idesubwindow - 6 + o(i).nam = idenewtxt("#Sorted A-Z") + o(i).sel = SortedSubsFLAG +END IF + + '-------- end of init -------- '-------- generic init -------- @@ -6567,6 +6648,9 @@ DO 'main loop '-------- end of generic display dialog box & objects -------- '-------- custom display changes -------- + IF FoundExternalSUBFUNC = -1 THEN + COLOR 8, 7: LOCATE idewy + idesubwindow - 3, p.x + 2: PRINT "* external"; + END IF '-------- end of custom display changes -------- 'update visual page and cursor position @@ -6617,26 +6701,80 @@ DO 'main loop IF K$ = CHR$(27) OR (focus = 3 AND info <> 0) THEN idesubs$ = "C" + GOSUB SaveSortSettings EXIT FUNCTION END IF IF K$ = CHR$(13) OR (focus = 2 AND info <> 0) OR (info = 1 AND focus = 1) THEN y = o(1).sel IF y < 1 THEN y = -y - idecy = CVL(MID$(ly$, y * 4 - 3, 4)) + if SortedSubsFLAG = 0 THEN + idecy = CVL(MID$(ly$, y * 4 - 3, 4)) + ELSE + idecy = CVL(MID$(lySorted$, y * 4 - 3, 4)) + END IF idesy = idecy idecx = 1 idesx = 1 + + GOSUB SaveSortSettings EXIT FUNCTION END IF + if TotalSUBs > 1 THEN + if o(3).sel <> SortedSubsFLAG then + SortedSubsFLAG = o(3).sel + + IF SortedSubsFLAG = 0 THEN + 'Replace list contents with unsorted version while mantaining current selection. + PreviousSelection = -1 + IF o(1).sel > 0 THEN + TargetSourceLine$ = MID$(lySorted$, o(1).sel * 4 - 3, 4) + for x = 1 to TotalSUBs + if MID$(ly$, x * 4 - 3, 4) = TargetSourceLine$ then + PreviousSelection = x + end if + next + END IF + + idetxt(o(1).txt) = l$ + o(1).sel = PreviousSelection + focus = 1 + ELSE + 'Replace list contents with sorted version while mantaining current selection. + PreviousSelection = -1 + IF o(1).sel > 0 THEN + TargetSourceLine$ = MID$(ly$, o(1).sel * 4 - 3, 4) + for x = 1 to TotalSUBs + if MID$(lySorted$, x * 4 - 3, 4) = TargetSourceLine$ then + PreviousSelection = x + end if + next + END IF + + idetxt(o(1).txt) = lSorted$ + o(1).sel = PreviousSelection + focus = 1 + END IF + end if + end if 'end of custom controls mousedown = 0 mouseup = 0 LOOP - +EXIT FUNCTION +SaveSortSettings: +If TotalSUBs > 1 and idesortsubs <> SortedSubsFLAG THEN + idesortsubs = SortedSubsFLAG + if idesortsubs then + WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "TRUE" + else + WriteConfigSetting "'[IDE DISPLAY SETTINGS]", "IDE_SortSUBs", "FALSE" + end if +END IF +RETURN END FUNCTION @@ -10110,5 +10248,278 @@ idet$ = l$ + m$ + r$ idecx = idecx + LEN(messagestr$) END SUB -'$INCLUDE:'wiki\wiki_methods.bas' +SUB Sort (m AS _MEM) 'Provided by Steve McNeill +DIM t AS LONG: t = m.TYPE +DIM i AS _UNSIGNED LONG +DIM ES AS LONG, EC AS LONG +IF NOT t AND 65536 THEN EXIT SUB 'We won't work without an array +IF t AND 1024 THEN DataType = 10 +IF t AND 1 THEN DataType = DataType + 1 +IF t AND 2 THEN DataType = DataType + 2 +IF t AND 4 THEN IF t AND 128 THEN DataType = DataType + 4 ELSE DataType = 3 +IF t AND 8 THEN IF t AND 128 THEN DataType = DataType + 8 ELSE DataType = 5 +IF t AND 32 THEN DataType = 6 +IF t AND 512 THEN DataType = 7 + +'Convert our offset data over to something we can work with +DIM m1 AS _MEM: m1 = _MEMNEW(8) +_MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size +_MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size +_MEMFREE m1 +EC = EC / ES - 1 'Now we take the whole element size / the size of the elements and get our actual element count. We subtract 1 so our arrays start at 0 and not 1. +'And work with it! +DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONG + +SELECT CASE DataType + CASE 1 'BYTE + DIM temp1(-128 TO 127) AS _UNSIGNED LONG + DIM t1 AS _BYTE + i = 0 + DO + _MEMGET m, m.OFFSET + i, t1 + temp1(t1) = temp1(t1) + 1 + i = i + 1 + LOOP UNTIL i > EC + i1 = -128 + DO + DO UNTIL temp1(i1) = 0 + _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE + counter = counter + 1 + temp1(i1) = temp1(i1) - 1 + IF counter > EC THEN EXIT SUB + LOOP + i1 = i1 + 1 + LOOP UNTIL i1 > 127 + CASE 2: 'INTEGER + DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG + DIM t2 AS INTEGER + i = 0 + DO + _MEMGET m, m.OFFSET + i * 2, t2 + temp2(t2) = temp2(t2) + 1 + i = i + 1 + LOOP UNTIL i > EC + i1 = -32768 + DO + DO UNTIL temp2(i1) = 0 + _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER + counter = counter + 1 + temp2(i1) = temp2(i1) - 1 + IF counter > EC THEN EXIT SUB + LOOP + i1 = i1 + 1 + LOOP UNTIL i1 > 32767 + CASE 3 'SINGLE + DIM T3a AS SINGLE, T3b AS SINGLE + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 4 + o1 = m.OFFSET + (i + gap) * 4 + IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN + _MEMGET m, o1, T3a + _MEMGET m, o, T3b + _MEMPUT m, o1, T3b + _MEMPUT m, o, T3a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 4 'LONG + DIM T4a AS LONG, T4b AS LONG + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 4 + o1 = m.OFFSET + (i + gap) * 4 + IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN + _MEMGET m, o1, T4a + _MEMGET m, o, T4b + _MEMPUT m, o1, T4b + _MEMPUT m, o, T4a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 5 'DOUBLE + DIM T5a AS DOUBLE, T5b AS DOUBLE + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 8 + o1 = m.OFFSET + (i + gap) * 8 + IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN + _MEMGET m, o1, T5a + _MEMGET m, o, T5b + _MEMPUT m, o1, T5b + _MEMPUT m, o, T5a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 6 ' _FLOAT + DIM T6a AS _FLOAT, T6b AS _FLOAT + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 32 + o1 = m.OFFSET + (i + gap) * 32 + IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN + _MEMGET m, o1, T6a + _MEMGET m, o, T6b + _MEMPUT m, o1, T6b + _MEMPUT m, o, T6a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 7 'String + DIM T7a AS STRING, T7b AS STRING, T7c AS STRING + T7a = SPACE$(ES): T7b = SPACE$(ES): T7c = SPACE$(ES) + gap = EC + DO + gap = INT(gap / 1.247330950103979) + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * ES + o1 = m.OFFSET + (i + gap) * ES + _MEMGET m, o, T7a + _MEMGET m, o1, T7b + IF T7a > T7b THEN + T7c = T7b + _MEMPUT m, o1, T7a + _MEMPUT m, o, T7c + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = false + CASE 8 '_INTEGER64 + DIM T8a AS _INTEGER64, T8b AS _INTEGER64 + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 8 + o1 = m.OFFSET + (i + gap) * 8 + IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN + _MEMGET m, o1, T8a + _MEMGET m, o, T8b + _MEMPUT m, o1, T8b + _MEMPUT m, o, T8a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 11: '_UNSIGNED _BYTE + DIM temp11(0 TO 255) AS _UNSIGNED LONG + DIM t11 AS _UNSIGNED _BYTE + i = 0 + DO + _MEMGET m, m.OFFSET + i, t11 + temp11(t11) = temp11(t11) + 1 + i = i + 1 + LOOP UNTIL i > EC + i1 = 0 + DO + DO UNTIL temp11(i1) = 0 + _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE + counter = counter + 1 + temp11(i1) = temp11(i1) - 1 + IF counter > EC THEN EXIT SUB + LOOP + i1 = i1 + 1 + LOOP UNTIL i1 > 255 + CASE 12 '_UNSIGNED INTEGER + DIM temp12(0 TO 65535) AS _UNSIGNED LONG + DIM t12 AS _UNSIGNED INTEGER + i = 0 + DO + _MEMGET m, m.OFFSET + i * 2, t12 + temp12(t12) = temp12(t12) + 1 + i = i + 1 + LOOP UNTIL i > EC + i1 = 0 + DO + DO UNTIL temp12(i1) = 0 + _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER + counter = counter + 1 + temp12(i1) = temp12(i1) - 1 + IF counter > EC THEN EXIT SUB + LOOP + i1 = i1 + 1 + LOOP UNTIL i1 > 65535 + CASE 14 '_UNSIGNED LONG + DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 4 + o1 = m.OFFSET + (i + gap) * 4 + IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN + _MEMGET m, o1, T14a + _MEMGET m, o, T14b + _MEMPUT m, o1, T14b + _MEMPUT m, o, T14a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 + CASE 18: '_UNSIGNED _INTEGER64 + DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64 + gap = EC + DO + gap = 10 * gap \ 13 + IF gap < 1 THEN gap = 1 + i = 0 + swapped = 0 + DO + o = m.OFFSET + i * 8 + o1 = m.OFFSET + (i + gap) * 8 + IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN + _MEMGET m, o1, T18a + _MEMGET m, o, T18b + _MEMPUT m, o1, T18b + _MEMPUT m, o, T18a + swapped = -1 + END IF + i = i + 1 + LOOP UNTIL i + gap > EC + LOOP UNTIL gap = 1 AND swapped = 0 +END SELECT +END SUB + + +'$INCLUDE:'wiki\wiki_methods.bas'