pb2html

Dr. Dri · Message par **Dr. Dri** » dim. 03/avr./2005 10:22

Un petit code source (que je devais transformer en petit utilitaire, je vous laisse la corvée) pour passer une source PB en HTML en respectant grossomodo les règles de coloration de l'éditeur windows...

Me suis inspiré d'un truc ki s'appelle pbnsu (cederavic ? me rappelle plus) et j'ai préféré faire un "parser" plutôt qu'un truc qui joue sur les expressions régulières... Et j'en ai fait une usine à gaz

Y'a plusieurs fichiers (pas cool je sais)

MotCle.sys

Code : Tout sélectionner

43
CallDebugger
CompilerCase
CompilerDefault
CompilerElse
CompilerEndIf
CompilerEndSelect
CompilerIf
CompilerSelect
Data
DataSection
Debug
DebugLevel
Declare
DeclareDLL
DefType
Dim
DisableDebugger
EnableDebugger
End
EndDataSection
EndProcedure
EndStructure
EndStructureUnion
EndEnumeration
Enumeration
FakeReturn
ForEver
Global
IncludeBinary
IncludeFile
IncludePath
NewList
Procedure
ProcedureDLL
ProcedureReturn
Protected
Read
Restore
Return
Shared
Structure
StructureUnion
XIncludeFile

ProgramFlow.sys

Code : Tout sélectionner

20
And
Case
Default
Else
ElseIf
EndIf
EndSelect
For
ForEach
Gosub
Goto
If
Next
Or
Repeat
Select
Step
To
Until
Wend
While

InitSyntaxe.pb

Code : Tout sélectionner

Dim MotCle.s(0)
Dim ProgramFlow.s(0)

Dim IndexMotCle.b(255)
Dim IndexProgramFlow.b(255)
Dim CaractereValide.b(255)

For i.l = 0 To 255
  IndexMotCle     (i) = -1
  IndexProgramFlow(i) = -1
  CaractereValide (i) = #FALSE
Next i

Global nbMotCle.l, nbProgramFlow.l

Procedure InitSyntaxe(*Coloration.Long, Fichier.l, Quantite.l)
  Protected i.l, Chaine$, Longueur.l
  
  If IsFile(Fichier) And Eof(Fichier) = #FALSE
    
    i = 0
    While Eof(Fichier) = #FALSE And i < Quantite
      Chaine$ = ReadString()
      Longueur = Len(Chaine$)
      If *Coloration\l <> #NULL
        FreeMemory(*Coloration\l)
      EndIf
      PokeL(*Coloration, AllocateMemory(Longueur + 1))
      PokeS(*Coloration\l, Chaine$, Longueur)
      i + 1
      *Coloration + 4
    Wend
    
    CloseFile(Fichier)
  EndIf
  
EndProcedure

Procedure EstMotCle(Mot$)
  Protected i.l, Quitter.l, Resultat.l, MotCle$
  
  Resultat = -1
  Mot$ = LCase(Mot$)
  i = IndexMotCle( Asc(Mot$) )
  
  If i >= #NUL 
    
    While Quitter = #FALSE And i < nbMotCle
      
      MotCle$ = LCase( MotCle(i) )
      
      If MotCle$ <= Mot$
      
        If MotCle$ = Mot$
          Resultat = i
        EndIf
        
      Else
        Quitter = #TRUE
      EndIf

      i + 1
    Wend
    
  EndIf

  ProcedureReturn Resultat
EndProcedure

Procedure EstProgramFlow(Mot$)
  Protected i.l, Quitter.l, Resultat.l, ProgramFlow$
  
  Resultat = -1
  Mot$ = LCase(Mot$)
  i = IndexProgramFlow( Asc(Mot$) )
  
  If i >= 0
    
    While Quitter = #FALSE And i < nbProgramFlow
      
      ProgramFlow$ = LCase( ProgramFlow(i) )
      
      If ProgramFlow$ <= Mot$
      
        If ProgramFlow$ = Mot$
          Resultat = i
        EndIf
        
      Else
        Quitter = #TRUE
      EndIf

      i + 1
    Wend
    
  EndIf

  ProcedureReturn Resultat
EndProcedure

Procedure EstOperateur(c.l)
  If c = '=' Or c = '+' Or c = '-' Or c = '*' Or c = '/' Or c = '%' Or c = '&' Or c = '|' Or c = '!' Or c = '~' Or c = '<' Or c = '>'
    ProcedureReturn #TRUE
  EndIf
  ProcedureReturn #FALSE
EndProcedure

Procedure EstSeparateur(c.l)
  If c = '(' Or c = ')' Or c = '[' Or c = ']' Or c = '.' Or c = ',' Or c = ':' Or c = '\'
    ProcedureReturn #TRUE
  EndIf
  ProcedureReturn #FALSE
EndProcedure

Fichier.l = ReadFile(#PB_Any, "MotCle.sys")
If Fichier And Eof(Fichier) = #FALSE

  nbMotCle = Val( ReadString() )
  If nbMotCle > 0
    Dim MotCle.s(nbMotCle - 1)
    InitSyntaxe(@MotCle(), Fichier, nbMotCle)
    
    AncienCaractere.l = #NUL
    
    For i = 0 To nbMotCle - 1
      
      Caractere.l = Asc( LCase( MotCle(i) ) )
      If Caractere <> AncienCaractere
        IndexMotCle(Caractere) = i
        AncienCaractere = Caractere
      EndIf
      
    Next
  EndIf
  
EndIf

Fichier = ReadFile(#PB_Any, "ProgramFlow.sys")
If Fichier And Eof(Fichier) = #FALSE

  nbProgramFlow = Val( ReadString() )
  If nbProgramFlow > 0
    Dim ProgramFlow.s(nbProgramFlow - 1)
    InitSyntaxe(@ProgramFlow(), Fichier, nbProgramFlow)
  
    AncienCaractere = #NUL
    
    For i = 0 To nbProgramFlow - 1
      
      Caractere = Asc( LCase( ProgramFlow(i) ) )
      If Caractere <> AncienCaractere
        IndexProgramFlow(Caractere) = i
        AncienCaractere = Caractere
      EndIf
      
    Next
  EndIf
  
EndIf

CaractereValide('_') = #TRUE
For c.l = '0' To '9'
  CaractereValide(c) = #TRUE
Next c
For c = 'A' To 'Z'
  CaractereValide(c) = #TRUE
Next c
For c = 'a' To 'z'
  CaractereValide(c) = #TRUE
Next c

Syntaxe.pb

Code : Tout sélectionner

IncludeFile "initsyntaxe.pb"

Procedure$ HTMLChr(c.b)
  Select c
    Case '<'
      ProcedureReturn "<"
    Case '>'
      ProcedureReturn ">"
    Case '"'
      ProcedureReturn """
    Case '&'
      ProcedureReturn "&"
    Default
      ProcedureReturn Chr(c)
  EndSelect
EndProcedure

Procedure IsNumeric(str$)
  Protected *c.Byte
  *c = @str$
  If *c\b = #NULL
    ProcedureReturn #FALSE
  EndIf
  While *c\b <> #NULL
    If *c\b < '0' Or *c\b > '9'
      ProcedureReturn #FALSE
    EndIf
    *c + 1
  Wend
  ProcedureReturn #TRUE
EndProcedure

Procedure$ Colorer(Ligne$)
  
  html$ = #NULL$
  *Temp.Byte = #NULL
  *Caractere.Byte = @Ligne$
  
  While *Caractere\b <> #NULL
    
    Introducteur.l = #NULL
    Separateur.l   = #NULL
    Mot$           = #NULL$
    EspacesApres$  = #NULL$
    
    While *Caractere\b = ' ' Or *Caractere\b = '	'
      html$ + Chr(*Caractere\b)
      *Caractere + 1
    Wend
    
    If CaractereValide(*Caractere\b & $FF) = #FALSE
      Introducteur = *Caractere\b
      *Caractere + 1
    EndIf
    
    While CaractereValide(*Caractere\b & $FF)
      Mot$ + Chr(*Caractere\b)
      *Caractere + 1
    Wend
    
    While *Caractere\b = ' ' Or *Caractere\b = '	'
      EspacesApres$ + Chr(*Caractere\b)
      *Caractere + 1
    Wend
    
    If CaractereValide(*Caractere\b & $FF) Or *Caractere\b = #NULL
      Separateur = ' '
    Else
      Separateur = *Caractere\b
    EndIf
    
    If Introducteur = '%'
      
      Nombre.l = #TRUE
      *Temp = @Mot$
      While *Temp\b <> #NULL
        If *Temp\b <> '0' And *Temp\b <> '1'
          Nombre = #FALSE
        EndIf
        *Temp + 1
      Wend
      html$ + "<span class=" + Chr('"') + "nb" + Chr('"') + ">%"
      If Nombre = #TRUE
        html$ + Mot$ + "</span>" + EspacesApres$
      Else
        html$ + "</span>" + Mot$ + EspacesApres$
      EndIf
      Mot$ = #NULL$
      
    ElseIf Introducteur = '$'
      
      Nombre.l = #TRUE
      *Temp = @Mot$
      While *Temp\b <> #NULL
        Ascii = Asc( LCase( Chr(*Temp\b) ) )
        If (Ascii < '0' Or Ascii > '9') And (Ascii < 'a' Or Ascii > 'f')
          Nombre = #FALSE
        EndIf
        *Temp + 1
      Wend
      html$ + "<span class=" + Chr('"') + "nb" + Chr('"') + ">$"
      If Nombre = #TRUE
        html$ + Mot$ + "</span>" + EspacesApres$
      Else
        html$ + "</span>" + Mot$ + EspacesApres$
      EndIf
      Mot$ = #NULL$
      
    ElseIf Introducteur = '#'
    
      html$ + "<span class=" + Chr('"') + "con" + Chr('"') + ">#" + Mot$
      If Separateur = '$'
        html$ + "$"
        *Caractere + 1
        Separateur = #NULL
      EndIf
      html$ + "</span>" + EspacesApres$
      Mot$ = #NULL$
      
    ElseIf Introducteur = '*'
    
      html$ + "<span class=" + Chr('"') + "ptr" + Chr('"') + ">*"
      html$ + Mot$ + "</span>" + EspacesApres$
      Mot$ = #NULL$
      
    ElseIf Introducteur = '@'
    
      html$ + "<span class=" + Chr('"') + "ptr" + Chr('"') + ">@"
      If Separateur <> '(' And Separateur <> '$'
        html$ + Mot$
        Mot$ = #NULL$
      EndIf
      html$ + "</span>"
      If Separateur <> '('
        html$ + EspacesApres$
      EndIf
      
    ElseIf Introducteur = '\' And Separateur <> '('And Separateur <> '$'
      
      If Mot$ <> #NULL$
        html$ + "<span class=" + Chr('"') + "struct" + Chr('"') + ">"
        html$ + Mot$ + "</span>" + EspacesApres$
        Mot$ = #NULL$
        EspacesApres$ = #NULL$
      EndIf
      
    ElseIf Introducteur = '.'
      
      If Mot$ <> #NULL$
        html$ + "<span class=" + Chr('"') + "type" + Chr('"') + ">"
        html$ + Mot$ + "</span>" + EspacesApres$
        Mot$ = #NULL$
        EspacesApres$ = #NULL$
      EndIf
      
    ElseIf EstOperateur(Introducteur)
    
      html$ + "<span class=" + Chr('"') + "op" + Chr('"') + ">"
      If Introducteur = '<'
        html$ + "<"
      ElseIf Introducteur = '>'
        html$ + ">"
      Else
        html$ + Chr(Introducteur)
      EndIf
      html$ + "</span>" + Mot$ + EspacesApres$
      
    ElseIf Introducteur = '"'
      
      Separateur = #NUL
      html$ + "<span class=" + Chr('"') + "str" + Chr('"') + ">""
      html$ + Mot$ + EspacesApres$
      While *Caractere\b <> #NULL And *Caractere\b <> '"'
        html$ + HTMLChr(*Caractere\b)
        *Caractere + 1
      Wend
      If *Caractere\b <> #NULL
        html$ + """
        *Caractere + 1
      EndIf
      html$ + "</span>"
      Mot$ = #NULL$
      If CaractereValide(*Caractere\b & $FF) Or *Caractere\b = #NULL
        Separateur = ' '
      Else
        Separateur = *Caractere\b
      EndIf
      
    ElseIf Introducteur = 39 ; quote 'simple'
      
      Separateur = #NUL
      html$ + "<span class=" + Chr('"') + "con" + Chr('"') + ">'"
      html$ + Mot$ + EspacesApres$
      While *Caractere\b <> #NULL And *Caractere\b <> 39
        html$ + HTMLChr(*Caractere\b)
        *Caractere + 1
      Wend
      If *Caractere\b <> #NULL
        html$ + "'"
        *Caractere + 1
      EndIf
      html$ + "</span>"
      Mot$ = #NULL$
      If CaractereValide(*Caractere\b & $FF) Or *Caractere\b = #NULL
        Separateur = ' '
      Else
        Separateur = *Caractere\b
      EndIf
      
    ElseIf Introducteur = ';'
      
      Separateur = #NUL
      html$ + "<span class=" + Chr('"') + "rem" + Chr('"') + ">;"
      html$ + Mot$ + EspacesApres$
      While *Caractere\b <> #NULL
        html$ + HTMLChr(*Caractere\b)
        *Caractere + 1
      Wend
      html$ + "</span>"
      Mot$ = #NULL$
      
    EndIf
    
    Mot.l = EstMotCle(Mot$)
    If Mot >= 0
      html$ + "<span class=" + Chr('"') + "mc" + Chr('"') + ">"
      html$ + "<b>" + MotCle(Mot) + "</b>" + "</span>" + EspacesApres$
      Mot$ = #NULL$
      EspacesApres$ = #NULL$
    Else
      Mot = EstProgramFlow(Mot$)
      If Mot >= 0
        html$ + "<span class=" + Chr('"') + "pf" + Chr('"') + ">"
        html$ + "<b>" + ProgramFlow(Mot) + "</b>" + "</span>" + EspacesApres$
        Mot$ = #NULL$
        EspacesApres$ = #NULL$
      EndIf
    EndIf
    
    If Separateur = '(' And Mot$ <> #NULL$
      
      html$ + "<span class=" + Chr('"') + "cmd" + Chr('"') + ">"
      html$ + Mot$ + "</span>" + EspacesApres$
      html$ + "<span class=" + Chr('"') + "sp" + Chr('"') + ">(</span>"
      
    ElseIf Separateur = '%' And (Mot$ <> #NULL$ Or Mot >= 0)
      
      html$ + Mot$ + EspacesApres$
      html$ + "<span class=" + Chr('"') + "op" + Chr('"') + ">%</span>"
      *Caractere + 1
      
    ElseIf Separateur = '$' And Mot$ <> #NULL$ And EspacesApres$ = #NULL$
      
      html$ + "<span class=" + Chr('"') + "var" + Chr('"') + ">"
      html$ + Mot$ + "$</span>"
      *Caractere + 1
      If EstSeparateur(*Caractere\b)
        html$ + "<span class=" + Chr('"') + "sp" + Chr('"') + ">"
        html$ + Chr(*Caractere\b) + "</span>"
      EndIf
      
    ElseIf Separateur = '$' And Mot >= 0
      
      html$ + "$"
      *Caractere + 1
      
    ElseIf Separateur = ':'
      
      If Mot$ <> #NULL$
        html$ + "<span class=" + Chr('"') + "lbl" + Chr('"') + ">"
        html$ + Mot$ + "</span>" + EspacesApres$
      EndIf
      html$ + "<span class=" + Chr('"') + "sp" + Chr('"') + ">:</span>"
      
    ElseIf Separateur = '\'
      
      If Mot$ <> #NULL$
        html$ + "<span class=" + Chr('"') + "struct" + Chr('"') + ">"
        html$ + Mot$ + "</span>" + EspacesApres$
      EndIf
      html$ + "<span class=" + Chr('"') + "sp" + Chr('"') + ">\</span>"
      
    ElseIf EstOperateur(Separateur) And Separateur <> '%'
      
      html$ + Mot$ + EspacesApres$
      html$ + "<span class=" + Chr('"') + "op" + Chr('"') + ">"
      If Separateur = '<'
        html$ + "<"
      ElseIf Separateur = '>'
        html$ + ">"
      Else
        html$ + Chr(Separateur)
      EndIf
      html$ + "</span>"
      *Caractere + 1
      
    ElseIf EstSeparateur(Separateur)
      
      html$ + Mot$ + EspacesApres$
      html$ + "<span class=" + Chr('"') + "sp" + Chr('"') + ">"
      html$ + Chr(Separateur) + "</span>"
      
    Else
      
      If IsNumeric(Mot$)
        Mot$ = "<span class=" + Chr('"') + "nb" + Chr('"') + ">" + Mot$ + "</span>"
      EndIf
      html$ + Mot$; + EspacesApres$
      
    EndIf
    
  Wend
  
  html$ + Chr(13) + Chr(10)
  
  ProcedureReturn html$
  
EndProcedure

Procedure ExporterHTML(Source$, Cible$, Titre$)

  Source.l = ReadFile(#PB_Any, Source$)
  If Source <> #FALSE
    
    DeleteFile(Cible$)
    
    Cible.l = OpenFile(#PB_Any, Cible$)
    If Cible <> #FALSE
      
      UseFile(Cible)
      
      EOL$ = Chr(13) + Chr(10)
      
      WriteString("<html>" + EOL$)
      WriteString("<head>" + EOL$)
      
      WriteString("  <title>" + EOL$)
      *c.Byte = @Titre$
      While *c\b <> #NULL
        WriteString(HTMLChr(*c\b))
        *c + 1
      Wend
      WriteString("</title>" + EOL$)
      
      WriteString("  <meta name=" + Chr('"') + "generator" + Chr('"') + " content=" + Chr('"') + "pb2html" + Chr('"') + ">" + EOL$)
      WriteString("  <meta name=" + Chr('"') + "author" + Chr('"') + " content=" + Chr('"') + "Dr. Dri" + Chr('"') + ">" + EOL$)
      WriteString("  <link rel=" + Chr('"') + "stylesheet" + Chr('"') + " type=" + Chr('"') + "text/css" + Chr('"') + " href=" + Chr('"') + "pb2html.css" + Chr('"') + " />" + EOL$)
      WriteString("</head>" + EOL$)
      WriteString("<body>" + EOL$)
      WriteString("<pre class=" + Chr('"') + "pb" + Chr('"') + ">" + EOL$)
      
      While Eof(Source) = #FALSE
        UseFile(Source)
        ligne$ = ReadString()
        
        UseFile(Cible)
        WriteString( Colorer(ligne$) )
      Wend
      
      WriteString("</pre>" + EOL$ + "</body>" + EOL$ + "</html>" + EOL$)
      
      CloseFile(Cible)
    Else
      MessageRequester("Exporter HTML", "Le fichier n'a pas pu être créé :" + Chr(13) + Chr(10) + Cible$, #MB_ICONERROR)
    EndIf
    
    CloseFile(Source)
    Open.l = MessageRequester("Exporter HTML", "Le fichier a été créé." + Chr(13) + Chr(10) + "Voulez vous l'ouvrir ?", #PB_MessageRequester_YesNo | #MB_ICONQUESTION)
    If Open = #TRUE
      Resultat = RunProgram("file:///" + Cible$) 
    EndIf
    
  Else
    MessageRequester("Exporter HTML", "Le fichier n'a pas pu être ouvert :" + Chr(13) + Chr(10) + Source$, #MB_ICONERROR)
  EndIf
  
EndProcedure

Je pense qu'avec ça on a tout...

Dri

cederavic · Message par **cederavic** » dim. 03/avr./2005 10:26

PBNSU oui oui c'était bien moi

d'ailleur j'avais donné les sources

Dr. Dri · Message par **Dr. Dri** » dim. 03/avr./2005 10:48

Comme j'ai pas conservé les sources je ne me rappelai plus... Mais ca va tous mes neuronnes ne sont pas KO...

Enfin là j'ai des doutes... J'ai oublié la feuille de style qui accompage les pages html...

pb2html.css

Code : Tout sélectionner

body
{
	background-color: #FFFFDF;
}

pre.pb
{
	font: Courier 12pt;
	font-weight: normal;
	color: #000000;
}

pre.pb span.mc { color: #006666; }
pre.pb span.pf { color: #000099; }
pre.pb span.rem { color: #000099; }
pre.pb span.con { color: #660066; }
pre.pb span.str { color: #006666; }
pre.pb span.var { color: #666600; }
pre.pb span.cmd { color: #006666; }
pre.pb span.op { color: #FF0000; }
pre.pb span.sp { color: #DF00DF; }
pre.pb span.struct { color: #FFA500; }
pre.pb span.type { color: #00A5FF; }
pre.pb span.nb { color: #0000FF; }
pre.pb span.ptr { color: #808080; }
pre.pb span.lbl { color: #FF0000; }

Dri

Oliv · Message par **Oliv** » dim. 03/avr./2005 10:50

Ton PBNSU est preatique et je m'en sert de temps en temps mais j'ai l'impression que la version de Dr.Dri est mieux

cederavic · Message par **cederavic** » dim. 03/avr./2005 11:55

faut dir que la miene date un peut

Progi1984 · Message par **Progi1984** » dim. 03/avr./2005 13:04

Quelqu'un a une adresse pour ce PBNSU ?

Heis Spiter · Message par **Heis Spiter** » dim. 03/avr./2005 13:07

http://ftp.heisspiter.no-ip.com/pub/for ... /PBNSU.rar

lionel_om · Message par **lionel_om** » jeu. 21/juil./2005 13:29

Tiens ya une faute dans ton code Dri :

Code : Tout sélectionner

Procedure$ HTMLChr(c.b)
  Select c
    Case '<'
      ProcedureReturn "<"
    Case '<'
      ProcedureReturn ">"
    Case '"'
      ProcedureReturn """
    Case '&'
      ProcedureReturn "&"
    Default
      ProcedureReturn Chr(c)
  EndSelect
EndProcedure

T'as deux fois : Case '<'

Dr. Dri · Message par **Dr. Dri** » jeu. 21/juil./2005 14:12

Bien vu! je corrige ca tout de suite!

Code : Tout sélectionner

Procedure$ HTMLChr(c.b)
  Select c
    Case '<'
      ProcedureReturn "<"
    Case '>'
      ProcedureReturn ">"
    Case '"'
      ProcedureReturn """
    Case '&'
      ProcedureReturn "&"
    Default
      ProcedureReturn Chr(c)
  EndSelect
EndProcedure

Dri ^^