PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

PureBasic-Code zu HTML mit Syntax-Herforhebung

https://www.purebasic.fr/german/viewtopic.php?t=10981

Seite 1 von 1

PureBasic-Code zu HTML mit Syntax-Herforhebung

Verfasst: 28.11.2006 22:26
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

Verfasst: 01.12.2006 11:44
von Leonhard
na?

gibts keine freedbacks?

Verfasst: 01.12.2006 12:14
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! ;-)

Verfasst: 01.12.2006 13:56
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!

Verfasst: 01.12.2006 15:58
von Leonhard
ooops :oops:

habs gleich berichtigt. Danke.

Verfasst: 01.12.2006 16:04
von remi_meier
@Kiffi: Ist ja auch nicht UTF-8 kompatibel :mrgreen:
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de