PureBasic-Code zu HTML mit Syntax-Herforhebung

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
Benutzeravatar
Leonhard
Beiträge: 602
Registriert: 01.03.2006 21:25

PureBasic-Code zu HTML mit Syntax-Herforhebung

Beitrag von Leonhard »

Falls es jemand gebrauchen kann. Der Code übersetzt eine PureBasic Code-Datei in HTML (mit Syntax-Hervorhebung!!!!). Hab das ganze mal mit ner kleinen Anzeige-Umgebung umschmückt, damit man testen kann.

Bitte postent eure Meinung zum Code.

Code: Alles auswählen

;/ Autor: leonhard

;{ PureBasic-Sorce zu HTML
Procedure.b __SorceToHTMLSyntaxPB_if_OperatorFirstChar(sChar.s)
  Select sChar
    Case "(", ")", "{", "}", "[", "]"
    Case ",", ".", "\"
    Case ":"
    
    Case "+", "-", "*", "/"
    Case "~", "%", "!"
    Case "|", "&"
    
    Case "<", ">", "="
    Default : ProcedureReturn #False
  EndSelect
  ProcedureReturn #True
EndProcedure
Procedure.b __SorceToHTMLSyntaxPB_if_OperatorChar(sOperator.s)
  Select sOperator
    Case "(", ")", "{", "}", "[", "]"
    Case ",", ".", "\"
    Case ":"
    
    Case "+", "-", "*", "/"
    Case "~", "%", "!"
    Case "|", "&"
    
    Case "<<", ">>"
    Case "<", ">", "="
    Case "<=", ">=", "<>"
    Default : ProcedureReturn #False
  EndSelect
  ProcedureReturn #True
EndProcedure
Procedure.b __SorceToHTMLSyntaxPB_IsKeyword(String$)
  Select LCase(String$)
    Case "and", "or", "xor", "not"
    
    Case "break", "continue"
    
    Case "for", "foreach", "to", "step", "next"
    Case "repeat", "until", "forever"
    Case "while", "wend"
    
    Case "if", "elseif", "else", "endif"
    Case "select", "case", "default", "endselect"
    
    Case "gosub", "goto", "fakereturn"
    Case "return"
    
    Case "compilerif", "compilerelseif", "compilerelse", "compilerendIf"
    Case "compilerselect", "compilercase", "compilerdefault", "compilerendselect"
    Case "compilererror"
    Case "enableexplicit", "disableexplicit"
    
    Case "datasection", "data", "enddatasection"
    Case "restore", "read"
    
    Case "calldebugger"
    Case "debug", "debuglevel"
    Case "disabledebugger", "enabledebugger"
    
    Case "procedure", "procedurec", "procedurecdll", "proceduredll"
    Case "endprocedure", "procedurereturn"
    
    Case "declare", "protected", "global", "shared", "static"
    
    Case "prototype"
    
    Case "extends"
    Case "structure", "endstructure"
    Case "structureunion", "endstructureunion"
    Case "with", "endwith"
    
    Case "dim", "redim"
    Case "newlist"
    
    Case "end"
    
    Case "swap"
    
    Case "includefile", "xincludefile", "includebinary", "includepath"
    Default
      ProcedureReturn #False
  EndSelect
  
  ProcedureReturn #True
EndProcedure
Procedure.s DefineHTMLColor(lColor)
  ProcedureReturn "#"+RSet(Hex(Red(lColor)), 2, "0")+RSet(Hex(Green(lColor)), 2, "0")+RSet(Hex(Blue(lColor)), 2, "0")
EndProcedure
Macro SorceToHTMLSyntaxPB_SetNextIdentifier_False()
  If bNextIdentifier = #True
    OutSorce$ + "</span>"
    bNextIdentifier = #False
  EndIf
EndMacro
Procedure.s SorceToHTMLSyntaxPB(Sorce$)
  Protected lPos.l = 1
  Protected lLen = Len(Sorce$)
  Protected sChar.s
  Protected bActiveComment.b
  Protected s1.s
  Protected l1.l
  Protected b1.b
  
  Protected lColor_Comment.l    = RGB(0  , 128, 0)
  Protected lColor_Operator.l   = RGB(255, 128, 0)
  Protected lColor_String.l     = RGB(164, 164, 0)
  Protected lColor_Integer.l    = RGB(164, 164, 255)
  Protected lColor_Identifier.l = RGB(0  , 0  , 0)
  Protected lColor_Constant.l   = RGB(255, 0  , 0)
  Protected lColor_Keyword.l    = RGB(0  , 0  , 255)
  Protected lColor_Label.l      = RGB(128, 128, 128)
  Protected lColor_Function.l   = RGB(0  , 128, 128)
  Protected lColor_Pointer.l    = RGB(255, 0  , 255)
  Protected lColor_Structure.l  = $FF8944
  
  Protected bNextIdentifier.b
  
  Protected OutSorce$
  
  While lPos < lLen
    Debug StrF(lPos/lLen*100, 2)+"%"
    sChar = Mid(Sorce$, lPos, 1);Chr(PeekB(@Sorce$+lPos-1))
    
    If sChar = ";" ;{ Kommentar
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Comment)+"'>"
      While sChar <> Chr(13)
        OutSorce$ + sChar
        
        lPos + 1
        sChar = Mid(Sorce$, lPos, 1)
      Wend
      OutSorce$ + "</span>"
    ;}
    ElseIf __SorceToHTMLSyntaxPB_if_OperatorFirstChar(sChar) ;{ Operator
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      s1 = sChar
      If __SorceToHTMLSyntaxPB_if_OperatorChar(s1+Mid(Sorce$, lPos+1, 1))
        s1 + Mid(Sorce$, lPos+1, 1)
        lPos + 1
      EndIf
      
      If __SorceToHTMLSyntaxPB_if_OperatorChar(s1)
        b1 = #False
        If s1 = "." Or s1 = "\"
          bNextIdentifier = #True
          OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Structure)+"'>"
        ElseIf s1 = "*"
          sChar = Mid(Sorce$, lPos+1, 1)
          If sChar = "_" Or (Asc(sChar) >= 'a' And Asc(sChar) <= 'z') Or (Asc(sChar) >= 'A' And Asc(sChar) <= 'Z')
            b1 = #True
            bNextIdentifier = #True
            OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Pointer)+"'>"
            OutSorce$ + s1
          EndIf
        EndIf
        
        If b1 = #False
          OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Operator)+"'>"
          OutSorce$ + s1
          OutSorce$ + "</span>"
        EndIf
        
        sChar = ""
      EndIf
    ;}
    ElseIf sChar = Chr($22) ;{ String
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_String)+"'>"
      While sChar <> Chr(13)
        OutSorce$ + sChar
        
        lPos + 1
        sChar = Mid(Sorce$, lPos, 1)
        If sChar = Chr($22)
          OutSorce$ + sChar
          Break
        EndIf
      Wend
      OutSorce$ + "</span>"
      sChar = ""
    ;}
    ElseIf sChar = "'" ;{ IntString
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      OutSorce$ + "<span style='color: red'>"
      While sChar <> Chr(13)
        OutSorce$ + sChar
        
        lPos + 1
        sChar = Mid(Sorce$, lPos, 1)
        If sChar = "'"
          OutSorce$ + sChar
          Break
        EndIf
      Wend
      OutSorce$ + "</span>"
      sChar = ""
    ;}
    ElseIf Asc(sChar) >= '0' And Asc(sChar) <= '9' ;{ Intergreter
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      s1 = ""
      While (Asc(sChar) >= '0' And Asc(sChar) <= '9') Or sChar = Chr(13)
        s1 + sChar
        
        lPos + 1
        sChar = Mid(Sorce$, lPos, 1)
      Wend
      lPos - 1
      OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Integer)+"'>"
      OutSorce$ + s1
      OutSorce$ + "</span>"
      sChar = ""
    ;}
    ElseIf sChar = "#" ;{ Konstante
      bNextIdentifier = #True
      OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Constant)+"'>"
    ;}
    ElseIf sChar = "@" Or sChar = "?" ;{ Pointer -> Zeiger
      bNextIdentifier = #True
      OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Pointer)+"'>"
      ;}
    ElseIf sChar = "_" Or (Asc(sChar) >= 'a' And Asc(sChar) <= 'z') Or (Asc(sChar) >= 'A' And Asc(sChar) <= 'Z') ;{ Identifier
      s1 = ""
      While sChar = "_" Or (Asc(sChar) >= 'a' And Asc(sChar) <= 'z') Or (Asc(sChar) >= 'A' And Asc(sChar) <= 'Z') Or sChar = "$" Or (Asc(sChar) >= '0' And Asc(sChar) <= '9')
        s1 + sChar
        
        lPos + 1
        sChar = Mid(Sorce$, lPos, 1)
      Wend
      lPos - 1
      If bNextIdentifier = #False
        If __SorceToHTMLSyntaxPB_IsKeyword(s1)
          OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Keyword)+"; font-weight: bold'>"
        Else
          l1 = 1
          sChar = Mid(Sorce$, lPos+l1, 1)
          While sChar = " " Or sChar = #TAB$
            l1 + 1
            sChar = Mid(Sorce$, lPos+l1, 1)
          Wend
          If sChar = ":"
            OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Label)+"'>"
          ElseIf sChar = "("
            OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Function)+"'>"
          Else
            OutSorce$ + "<span style='color: "+DefineHTMLColor(lColor_Identifier)+"'>"
          EndIf
        EndIf
      Else
        bNextIdentifier = #False
      EndIf
      OutSorce$ + s1
      OutSorce$ + "</span>"
      sChar = ""
    ;}
    ElseIf sChar = Chr(13) ;{ Zeilenende
      SorceToHTMLSyntaxPB_SetNextIdentifier_False()
      ;}
    ElseIf sChar = #NUL$
      Break
    EndIf
    
    OutSorce$ + sChar
    
    lPos + 1
  Wend
  
  Debug OutSorce$
  
  ProcedureReturn OutSorce$
EndProcedure
;}

File$=OpenFileRequester("Bitte eine PureBasic-Sorce-Datei angeben", "", "PureBasic-Dateien (*.pb;*.pbi;*.pbv)|*.pb;*.pbi;*.pbv|Alle Dateien (*.*)|*.*", 0)
If Len(File$) = 0
  End
EndIf
If ReadFile(1, File$)=0
  MessageRequester("", "Konnte die Datei nicht öffnen")
  End
EndIf
lLen.l=Lof(1)
*Buffer=AllocateMemory(lLen)
lLen=ReadData(1, *Buffer, lLen)
Sorce$=PeekS(*Buffer, lLen)
CloseFile(1)
Debug "Erstelle den HTML-Code"
Sorce$=SorceToHTMLSyntaxPB(Sorce$)
Debug "Ende der Erstellung"

TmpFile$=GetEnvironmentVariable("tmp")+"test_page.htm"
Debug "Erstelle Temp-Datei"
CreateFile(1, TmpFile$)
Debug "Schreibe in Temp-Datei"
WriteString(1, "<pre style='font-family:'Courier New', Courier, monospace; font-size: 12px;'>"+Sorce$+"</pre>")
Debug "Schließe Temp-Datei"
CloseFile(1)

Debug "Baue Oberfläche auf"
OpenWindow(1, 0, 0, 800, 600, "PureBasic-SorceCode zu HTML-Text", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
CreateGadgetList(WindowID(1))
WebGadget(1, 0, 0, WindowWidth(1), WindowHeight(1), TmpFile$)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_SizeWindow
      ResizeGadget(1, 0, 0, WindowWidth(1), WindowHeight(1))
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver

If DeleteFile(TmpFile$)=0
  MessageRequester("", "Konnte die Temp-Datei ("+TmpFile$+") nicht löschen.")
EndIf

End
Zuletzt geändert von Leonhard am 31.07.2018 11:49, insgesamt 2-mal geändert.
Nach oben
Benutzeravatar
Leonhard
Beiträge: 602
Registriert: 01.03.2006 21:25

Beitrag von Leonhard »

na?

gibts keine freedbacks?
Nach oben
Benutzeravatar
Kiffi
Beiträge: 10711
Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9

Beitrag von Kiffi »

> gibts keine freedbacks?

hab's gerade mal mit mehreren Sourcen ausprobiert. Im Debugger werden
Prozenzahlen bis so um die 99.3, 99.8 ausgegeben und dann passiert nix
mehr. Ich schätze mal, dass Deine While - Wend - Schleife nicht verlassen
wird.

Grüße ... Kiffi

// Edit: Und bitte tu mir einen Gefallen! Ändere 'Sorce' in 'Source'. Danke! ;-)
a²+b²=mc²
Nach oben
Benutzeravatar
AND51
Beiträge: 5220
Registriert: 01.10.2005 13:15

Beitrag von AND51 »

Habe es nicht getestet, aber einen schwerwiegenden Bug gefunden! :mrgreen: Nur vom durchlesen des Codes!
Procedure.b __SorceToHTMLSyntaxPB_IsKeyword(String$)
Select LCase(String$)
Case "and", "or", "xor", "not"

Case "break", "Continue"
Continue musst du klein schreiben, sonst wird es nicht gefunden, weil du LCase() benutzt!
PB 4.30

Code: Alles auswählen

Macro Happy
 ;-)
EndMacro

Happy End
Nach oben
Benutzeravatar
Leonhard
Beiträge: 602
Registriert: 01.03.2006 21:25

Beitrag von Leonhard »

ooops :oops:

habs gleich berichtigt. Danke.
Zuletzt geändert von Leonhard am 31.07.2018 11:48, insgesamt 1-mal geändert.
Nach oben
Benutzeravatar
remi_meier
Beiträge: 1078
Registriert: 29.08.2004 20:11
Wohnort: Schweiz

Beitrag von remi_meier »

@Kiffi: Ist ja auch nicht UTF-8 kompatibel :mrgreen:
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“