PureBasic Forums - English

Code: Select all

Mark(1)\color = $BBBBBB
Mark(2)\color = $32CEED
Mark(3)\color = 0
Mark(4)\color = $004284
Mark(5)\color = $0000FF
Mark(6)\color = $0084FF
Mark(7)\color = $00FFFF
Mark(8)\color = $00DD00
Mark(9)\color = $FF5B3B
Mark(10)\color = $FF3D9E
Mark(11)\color = $999999
Mark(12)\color = $FFFFFF

Code: Select all

=> aa
=> ff3d9e
=> ffffff
=> dd00
=> ffff
=> ceed
=> ff5b3b
=> bbbbbb

Code: Select all

; ------------------------------------------------------------
;
;   PureBasic - Syntax hilightning dll example
;
;    (c) 2010 - Fantaisie Software
;
; ------------------------------------------------------------
;
; The SyntaxHilighting.dll provides the syntax parser of the 
; PureBasic IDE in form of a dll, so it can be easily reused
; to do other tasks as well.
;
; Some notes:
;
; - For speed reasons, the dll is not threadsave.
;
; - The hilighter does not handle unicode. It does however handle UTF8, so if
;   Unicode text should be parsed, convert it to UTF8 first.
;
; The dll exports only one function:
;
;    SyntaxHighlight(*Buffer, Length, @Callback(), EnableAsm)
;
; *Buffer and Length specify the text buffer to parse.
;
; Callback() must have the parameters as in the example below and will be called
; for each parsed token.
;
; If EnableAsm is set to nonzero, the parser will report asm keywords also outside of
; the special ! lines, just as the InlineAsm parser does.
;

; Color values returned in the Dll callback
;

EnableExplicit

Enumeration
	#SYNTAX_Text
	#SYNTAX_Keyword  
	#SYNTAX_Comment
	#SYNTAX_Constant
	#SYNTAX_String
	#SYNTAX_Function
	#SYNTAX_Asm
	#SYNTAX_Operator
	#SYNTAX_Structure
	#SYNTAX_Number
	#SYNTAX_Pointer
	#SYNTAX_Separator
	#SYNTAX_Label  
	#SYNTAX_Module
EndEnumeration

#Dll    = 0
#Input  = 0
#Output = 1

; Callback that is called from the dll. 
;
; NOTE: For performance reasons, whitespace characters (space, tab, newline)
; are returned together with the tokens they surround to reduce the number
; of required callback calls. If this is not desired, you must separate them
; here in the callback manually.
;
; The original buffer is not modified. The *Position parameter points to the
; current position in the original buffer. 
;

Declare.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
Declare.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")

Global Result.string, LenT
Global InputFile$, OutputFile$, *Buffer, Length, *Point, LenT2, tmp$

Global NewMap Res_Text()
Global NewMap Res_Structure()
Global NewMap Res_Pointer()
;
Procedure AddToMap(Map Res(), tmp$)
	tmp$ = RTrimChar(tmp$)
	tmp$ = LTrimChar(tmp$)

	If FindMapElement(Res() , tmp$)
		Res(tmp$) + 1
	Else
		AddMapElement(Res() , tmp$)
		Res(tmp$) = 1
	EndIf
EndProcedure

Procedure Callback(*Position, Length, Color)
	Protected tmp$, tmp
	
	; In this example, we simply write the data as it is to the output
	; buffer, and just apply bold to keywords, and colors to functions and comments.
	;
	tmp$ = PeekS(*Position, Length, #PB_UTF8 | #PB_ByteLength)
	Select Color
		Case #SYNTAX_Text
			AddToMap(Res_Text(), tmp$)
			
		Case #SYNTAX_Structure
			AddToMap(Res_Structure(), tmp$)
			
		Case #SYNTAX_Pointer
			AddToMap(Res_Pointer(), tmp$)
			ForEach Res_Pointer()
				tmp = Asc(MapKey(Res_Pointer()))
				If tmp = '@' Or tmp = '?' ; удаляем взятие указателя, так как такой код никогда не является объявлением имени переменной
					DeleteMapElement(Res_Pointer())
				EndIf
			Next
			
	EndSelect
	
EndProcedure

; Simple example code. It loads a PB file and outputs a HTML file withs some
; coloring for functions, keywords and comments
;
If OpenLibrary(#Dll, #PB_Compiler_Home + "SDK\Syntax Highlighting\SyntaxHighlighting.dll")  
	; If OpenLibrary(#Dll, GetPathPart(ProgramFilename()) + "SyntaxHighlighting.dll")

	InputFile$ = OpenFileRequester("Select PB File", "", "*.pb*|*.pb*|All Files|*.*", 0)
; 	InputFile$ = "C:\Source\2022.10\test.pb"
	If InputFile$
		
		If ReadFile(#Input, InputFile$) ; And CreateFile(#Output, OutputFile$)
			Length = Lof(#Input)
			*Buffer = AllocateMemory(Length)
			
			If *Buffer
				ReadData(#Input, *Buffer, Length) ; читаем исходник в файл
				
				CallFunction(#Dll, "SyntaxHighlight", *Buffer, Length, @Callback(), 0)
; 				после вызова функции получаем заполненные списки элементов и пишем их в файл
; 				WriteStringN(#Output, "") ; пишем строку
				
				; вычисляем длину данных для вмещения частей текста
				LenT = 0

; 				ForEach Res_Text()
; 					Debug Res_Text()
; 				Next
				
				ForEach Res_Text()
; 					Debug Res_Text()
					If Res_Text() <> 1
						DeleteMapElement(Res_Text()) ; добавляет лексему если число вхождений больше чем 1
					EndIf
				Next
				ForEach Res_Text()
					LenT + StringByteLength(MapKey(Res_Text()), #PB_Unicode)
				Next
				ForEach Res_Structure()
; 					Debug Res_Structure()
					If Res_Structure() <> 1
						DeleteMapElement(Res_Structure())
					EndIf
				Next
				ForEach Res_Structure()
					LenT + StringByteLength(MapKey(Res_Structure()), #PB_Unicode)
				Next
				ForEach Res_Pointer()
; 					Debug Res_Pointer()
					If Res_Pointer() <> 1
						DeleteMapElement(Res_Pointer())
					EndIf
				Next
				ForEach Res_Pointer()
					LenT + StringByteLength(MapKey(Res_Pointer()), #PB_Unicode)
				Next
				
				LenT2 + MapSize(Res_Text())
				LenT2 + MapSize(Res_Structure())
				LenT2 + MapSize(Res_Pointer())
				LenT + LenT2*4
				If MapSize(Res_Text())
					LenT + 22 ; "=== Var ==="
				EndIf
				If MapSize(Res_Structure())
					LenT + 38 ; "=== Structure ==="
				EndIf
				If MapSize(Res_Pointer())
					LenT + 34 ; "=== Pointer ==="
				EndIf
				
				Result\s = Space(LenT) ; создаём строку забивая её пробелами
				*Point = @Result\s		; Получаем адрес строки
				; копируем очередной путь в указатель
				If MapSize(Res_Text())
					CopyMemoryString("=== Var ===" + #CRLF$, @*Point)
				EndIf
				ForEach Res_Text()
; 					CopyMemoryString(Str(Res_Text()), @*Point) ; добавляет число вхождений
					CopyMemoryString(MapKey(Res_Text()) + #CRLF$, @*Point)
				Next
				
				If MapSize(Res_Structure())
					CopyMemoryString(#CRLF$ + "=== Structure ===" + #CRLF$, @*Point)
				EndIf
				ForEach Res_Structure()
; 					CopyMemoryString(Str(Res_Structure()), @*Point)
					CopyMemoryString(MapKey(Res_Structure()) + #CRLF$, @*Point)
				Next
				
				If MapSize(Res_Pointer())
					CopyMemoryString(#CRLF$ + "=== Pointer ===" + #CRLF$, @*Point)
				EndIf
				ForEach Res_Pointer()
; 					CopyMemoryString(Str(Res_Pointer()), @*Point)
					CopyMemoryString(MapKey(Res_Pointer()) + #CRLF$, @*Point)
				Next
; 				WriteStringFormat(#Output, #PB_UTF8)
				; 				WriteString(#Output, Result\s) ; пишем строку
				
				tmp$ = PeekS(@Result\s, StringByteLength(Result\s, #PB_Unicode), #PB_Unicode)
; 				MessageRequester("", tmp$)
; 				WriteData(#Output, @Result\s, StringByteLength(Result\s, #PB_Unicode)) ; по умолчанию сохраняется в #PB_UTF8

			EndIf    
			
			CloseFile(#Input)
; 			CloseFile(#Output)
		EndIf
		
	EndIf  
	
	CloseLibrary(#Dll)
Else
	MessageRequester("", "Failed to open SyntaxHighlighting.dll")
	End
EndIf


If Asc(tmp$)
	If OpenWindow(0, 10, 10, 220, 600, "Unused (?)", #PB_Window_SystemMenu)
		EditorGadget(0, 0, 0, 220 , 600)
		SetGadgetText(0 , tmp$)
		StickyWindow(0, #True) 
		
		Repeat
			If WaitWindowEvent() = #PB_Event_CloseWindow
				CloseWindow(0)
				End
			EndIf
		ForEver
	EndIf
EndIf


; https://www.purebasic.fr/english/viewtopic.php?t=79183
Procedure.s LTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected Len1, Len2, Blen, i, j
    Protected *memChar, *c.Character, *jc.Character

    Len1 = Len(TrimChar$)
    Len2 = Len(String$)
    Blen = StringByteLength(String$)

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c.Character = @String$
    *memChar = @TrimChar$

    For i = 1 To Len2
        *jc.Character = *memChar

        For j = 1 To Len1
            If *c\c = *jc\c
                *c\c = 0
                Break
            EndIf
            *jc + SizeOf(Character)
        Next

        If *c\c
            String$ = PeekS(*c)
            Break
        EndIf
        *c + SizeOf(Character)
    Next

    ProcedureReturn String$
EndProcedure

; https://www.purebasic.fr/english/viewtopic.php?t=79183
Procedure.s RTrimChar(String$, TrimChar$ = #CRLF$ + #TAB$ + #FF$ + #VT$ + " ")
    Protected Len1, Len2, Blen, i, j
    Protected *memChar, *c.Character, *jc.Character

    Len1 = Len(TrimChar$)
    Len2 = Len(String$)
    Blen = StringByteLength(String$)

    If Not Asc(String$)
        ProcedureReturn ""
    EndIf

    *c.Character = @String$ + Blen - SizeOf(Character)
    *memChar = @TrimChar$

    For i = Len2 To 1 Step -1
        *jc.Character = *memChar

        For j = 1 To Len1
            If *c\c = *jc\c
                *c\c = 0
                Break
            EndIf
            *jc + SizeOf(Character)
        Next

        If *c\c
            Break
        EndIf
        *c - SizeOf(Character)
    Next

    ProcedureReturn String$
EndProcedure

Code: Select all

Mark(1)\color = $BBBBBB
Mark(2)\color = $32CEED

Code: Select all

Structure MarkStruc
  color.i
EndStructure

Dim Mark.MarkStruc(2)

Mark(1)\color = $BBBBBB
Mark(2)\color = $32CEED

Code: Select all

Val(GetEnvironmentVariable("PB_TOOL_Scintilla") ; *** always zero"

Code: Select all

  OpenConsole()
  If ExamineEnvironmentVariables()
    While NextEnvironmentVariable()
      PrintN(EnvironmentVariableName() + " = " + EnvironmentVariableValue())
    Wend
  EndIf
  PrintN("")
  PrintN("Press Enter to quit.")
  Input()