Aktuelle Zeit: 13.12.2018 22:18

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 55 Beiträge ]  Gehe zu Seite 1, 2, 3, 4, 5, 6  Nächste
Autor Nachricht
 Betreff des Beitrags: [IDE-Tool]Einruecker
BeitragVerfasst: 19.10.2006 09:46 
Offline
Benutzeravatar

Registriert: 10.09.2004 09:59
Moin,

ich hab mich schon länger über so manche völlig unstrukturierten Beiträge hier im Board geärgert und daher mal g'schwind ein Auto-Einrück-Tool für die PB-IDE gebastelt.
O.k. ganz uneigennützig war das Ganze natürlich auch nicht:
Da ich sehr viele ältere PB-Projekte betreue und es früher mit der PB-IDE nicht möglich war Real-Tabs zu verwenden, hab ich nun meistens ein Gemisch aus Tabs und Spaces in meinen Source-Codes.
Das nervt mich einfach nur...

Das Tool schaut in eure IDE-Einstellungen (also ob Tabs, oder nicht Tabs) und setzt die Whitespaces entsprechend.

Blabla... peng ... blubberlutsch...
Wer immernoch nicht versteht, was dieses Tool macht, es macht aus dem hier:
Code:
Procedure Aha(Ameisenbaer,Affe,Hosenscheisser)
   Protected i,jaaa,keeeeee

 i=12
jaaa=222
      keeeeee=3333

     ProcedureReturn jaaaa
   EndProcedure


Aha(0,0,0)


das hier:

Code:
Procedure Aha(Ameisenbaer, Affe, Hosenscheisser)
   Protected i, jaaa, keeeeee

   i       = 12
   jaaa    = 222
   keeeeee = 3333

   ProcedureReturn jaaaa
EndProcedure


Aha(0, 0, 0)


//Edit:
Download entfernt, hier nun der (hoffentlich stets aktuelle) Source:
Code:
;/---------------
;| IDE-Tool
;| Einrücker
;|
;| (c)HeX0R 2007-2013
;| Do whatever you
;| like with this
;| source
;|
;| V1.07 (18.10.2017)
;/---------------

EnableExplicit

Enumeration
   #DIRECTIVE_COMPILERIF
   #DIRECTIVE_COMPILERSELECT
   #DIRECTIVE_COMPILERCASE
EndEnumeration

Structure _TAGS_
   Name.s
   Tabs.l
EndStructure

Structure _DIRECTIVE_HELPER_
   TabNum.i
   KindOFDirective.i
EndStructure

Procedure.s AddTabs(Tabs, Tab.s)
   Protected i, Result.s

   For i = 1 To Tabs
      Result + Tab
   Next i

   ProcedureReturn Result
EndProcedure

Procedure.s AddSpaces(Line.s)
   Protected *B.CHARACTER = @Line, Result.s, DQ, NeedSpace, u, v

   While *B\c
      If *B\c <> 32 And DQ = 0 And *B\c <> 39
         If NeedSpace = 1
            Result + " "
         ElseIf NeedSpace = 2
            ;If *B\c < '0' Or *B\c > '9'
            If *B\c < 48 Or *B\c > 57
               Result + " "
            EndIf
         ElseIf NeedSpace = 3
            ;If *B\c <> '=' And *B\c <> '<' And *B\c <> '>'
            If *B\c <> 61 And *B\c <> 60 And *B\c <> 62
               Result + " "
            EndIf
         EndIf
      EndIf
      NeedSpace = 0
      If *B\c = 34
         DQ ! 1
      EndIf

      If DQ
         Result + Chr(*B\c)
         ;ElseIf *B\c = ';'
      ElseIf *B\c = 59
         Result + Mid(Line, 1 + (*B - @Line) / SizeOf(CHARACTER))
         Break
      Else
         ;If *B\c = ','
         If *B\c = 44
            If Right(Result, 1) = " "
               Result = Left(Result, Len(Result) - 1)
            EndIf
            NeedSpace = 1
            u         = #True
            ;ElseIf *B\c = '!' Or *B\c = '+' Or *B\c = '/' Or *B\c = '%' Or *B\c = '|'
         ElseIf *B\c = 33 Or *B\c = 43 Or *B\c = 47 Or *B\c = 37 Or *B\c = 124
            If Right(Result, 1) <> "'"
               If Right(Result, 1) <> " "
                  Result + " "
               EndIf
               NeedSpace = 1
            EndIf
            u = 0
            ;ElseIf *B\c = '=' Or *B\c = '<' Or *B\c = '>'
         ElseIf *B\c = 61 Or *B\c = 60 Or *B\c = 62
            If Right(Result, 1) <> "'"
               u = #True
               If Right(Result, 1) <> " " And Right(Result, 1) <> "=" And Right(Result, 1) <> "<" And Right(Result, 1) <> ">"
                  Result + " "
               EndIf
               NeedSpace = 3
            EndIf
            ;ElseIf *B\c = '-'
         ElseIf *B\c = 45
            If Right(Result, 1) <> "'" And Right(RemoveString(LCase(Result), " "), 2) <> ".p"
               If Right(Result, 1) <> " "
                  Result + " "
               EndIf
               If u
                  NeedSpace = 2
               Else
                  NeedSpace = 1
               EndIf
            EndIf
            u = 0
         ElseIf *B\c = 32 Or *B\c = 9

         Else
            u = 0
         EndIf
         Result + Chr(*B\c)
      EndIf

      *B + SizeOf(CHARACTER)
   Wend

   ProcedureReturn Result
EndProcedure

Procedure EqualPos(Line.s)
   Protected *B.CHARACTER = @Line, Result, DQ

   If FindString(LCase(Line), "compilerif", 1) = 0 And FindString(LCase(Line), "compilerelseif", 1) = 0
      ;Find '=' in string
      While *B\c
         If *B\c = 34
            DQ ! 1
         EndIf
         If DQ = 0
            ;If *B\c = ';'
            If *B\c = 59
               Break
               ;ElseIf *B\c = '='
            ElseIf *B\c = 61
               Result = (1 + *B - @Line) / SizeOf(CHARACTER)
               Break
            EndIf
         EndIf

         *B + SizeOf(CHARACTER)
      Wend
   EndIf

   ProcedureReturn Result
EndProcedure

Procedure ReplaceTabs(*B.CHARACTER)
   ;Replace Tabs inside Line with Spaces (but not inside Strings!)
   Protected DQ

   While *B\c
      If *B\c = 34
         DQ ! 1
      EndIf
      If DQ = 0
         If *B\c = 9
            *B\c = 32
         EndIf
      EndIf

      *B + SizeOf(CHARACTER)
   Wend

EndProcedure


Procedure EqualLines(*PosSaved, MaxPos, List Lines.s())
   Protected *Index, i, a$

   *Index = @Lines()
   If *PosSaved
      ChangeCurrentElement(Lines(), *PosSaved)
      While @Lines() <> *Index
         a$ = Lines()
         i  = EqualPos(Lines())
         If i < MaxPos
            Lines() = Left(a$, i - 1) + RSet(" ", MaxPos - i, " ") + Mid(a$, i)
         EndIf
         NextElement(Lines())
      Wend
   EndIf

EndProcedure

Procedure.s MyTrim(Line.s)
   ;Normal Trim() doesn't handle Tabs correctly, so i had to write my own

   Protected *B.CHARACTER, Start = 1, Ende, Result.s

   If Line = ""
      ProcedureReturn ""
   EndIf

   *B = @Line
   Repeat
      If *B\c <> 32 And *B\c <> 9 And *B\c <> 0
         Break
      EndIf
      Start + 1
      *B + SizeOf(CHARACTER)
   ForEver
   Ende = Len(Line)
   *B   = @Line + (Ende - 1) * SizeOf(CHARACTER)
   Ende - Start
   Repeat
      If *B\c <> 32 And *B\c <> 9 And *B\c <> 0
         Break
      EndIf
      Ende - 1
      *B - SizeOf(CHARACTER)
   ForEver
   Result = Mid(Line, Start, Ende + 1)
   ;Now replace TABS


   ProcedureReturn Result
EndProcedure

Procedure.s GetCommand(Line.s)
   Protected *B.CHARACTER = @Line, Result.s

   While *B\c
      If *B\c < 97 Or *B\c > 122
         Break
      Else
         Result + Chr(*B\c)
      EndIf
      *B + SizeOf(CHARACTER)
   Wend

   ProcedureReturn Result
EndProcedure

Procedure.s FindCommand(Line.s, Index)
   ;Find next Command in this Line
   ;When User wrote more then
   ;just one Command in one Line via ':'
   ;For Example
   ;While WindowEvent() : Wend

   Protected i, DQ, *B.CHARACTER, Result.s

   If Line = ""
      ProcedureReturn ""
   EndIf

   i  = 1
   *B = @Line
   While *B\c <> 0
      If *B\c = 34
         DQ ! 1
      EndIf
      ;If *B\c = ':' And DQ = 0
      If *B\c = 58 And DQ = 0
         If i = Index
            Break
         Else
            i + 1
         EndIf
         ;ElseIf *B\c = ';'
      ElseIf *B\c = 59
         Break
      ElseIf i = Index
         Result + Chr(*B\c)
      EndIf
      *B + SizeOf(CHARACTER)
   Wend

   ProcedureReturn MyTrim(Result)

EndProcedure

Procedure CheckForEndTag(b$, Tag.s)
   ;Checks, whether the Start and End-Tag is in one line
   ;For Example
   ;While WindowEvent() : Wend
   Protected a$, Result = #True, i = 2

   a$ = FindCommand(b$, i)
   While a$ <> ""
      Select GetCommand(LCase(a$))
         Case "endif"
            If Tag = "if"
               Result = #False
               Break
            EndIf
         Case "endselect"
            If Tag = "select"
               Result = #False
               Break
            EndIf
         Case "until"
            If Tag = "repeat"
               Result = #False
               Break
            EndIf
         Case "forever"
            If Tag = "repeat"
               Result = #False
               Break
            EndIf
         Case "next"
            If Tag = "for" Or Tag = "foreach"
               Result = #False
               Break
            EndIf
         Case "wend"
            If Tag = "while"
               Result = #False
               Break
            EndIf
         Case "enddatasection"
            If Tag = "datasection"
               Result = #False
               Break
            EndIf
         Case "endprocedure"
            If Tag = "procedure" Or Tag = "procedurec" Or Tag = "proceduredll" Or Tag = "procedurecdll"
               Result = #False
               Break
            EndIf
         Case "endstructure"
            If Tag = "structure"
               Result = #False
               Break
            EndIf
         Case "endstructureunion"
            If Tag = "structureunion"
               Result = #False
               Break
            EndIf
         Case "endinterface"
            If Tag = "interface"
               Result = #False
               Break
            EndIf
         Case "endenumeration"
            If Tag = "enumeration"
               Result = #False
               Break
            EndIf
         Case "endwith"
            If Tag = "with"
               Result = #False
               Break
            EndIf
         Case "endimport"
            If Tag = "import" Or Tag = "importc"
               Result = #False
               Break
            EndIf
         Case "endmacro"
            If Tag = "macro"
               Result = #False
               Break
            EndIf
      EndSelect
      i + 1
      a$ = FindCommand(b$, i)
   Wend

   ProcedureReturn Result
EndProcedure

Procedure Main()
   Protected MyTab.s, i, j, a$, b$, Tabs, Found, *index, UTF_Flag
   Protected MiddleTagFound, MiddleTagDepth, *PosSaved, TabSaved, MaxPos, NumberOfLines

   NewList Lines.s()
   NewList Tags._TAGS_()
   NewList MTags._TAGS_()
   NewList CD._DIRECTIVE_HELPER_()

   OpenPreferences(GetEnvironmentVariable("PB_TOOL_Preferences"))
   PreferenceGroup("Global")
   If ReadPreferenceLong("RealTab", 0)
      MyTab = #TAB$
   Else
      MyTab = Space(ReadPreferenceLong("TabLength", 2))
   EndIf
   ClosePreferences()

   a$ = ProgramParameter()
   If a$ = "" Or ReadFile(0, a$) = 0
      MessageRequester("Error!", "Datei '" + a$ + "' nicht auffindbar!")
      End
   EndIf
   UTF_Flag = ReadStringFormat(0)
   If UTF_Flag <> #PB_UTF8
      UTF_Flag = #PB_Ascii
   EndIf
   Tabs = 3

   Restore Tags
   Repeat
      Read.s b$
      If b$ = ""
         Tabs - 1
         If Tabs = 0
            Break
         EndIf
      Else
         AddElement(Tags())
         Tags()\Tabs = Tabs
         Tags()\Name = b$
      EndIf
   ForEver

   While Eof(0) = 0
      AddElement(Lines())
      b$      = MyTrim(ReadString(0, UTF_Flag))
      ReplaceTabs(@b$)
      Lines() = AddSpaces(b$)
   Wend
   CloseFile(0)
   Tabs           = 0
   TabSaved       = -1
   MiddleTagDepth = 1

   ForEach Lines()
      b$    = GetCommand(LCase(Lines()))
      Found = #False
      ForEach Tags()
         If b$ = Tags()\Name
            Found = #True
            Select Tags()\Tabs
               Case 3
                  ;StartTag
                  If TabSaved > -1
                     If NumberOfLines > 1
                        EqualLines(*PosSaved, MaxPos, Lines())
                     EndIf
                     NumberOfLines = 0
                     TabSaved      = -1
                     MaxPos        = 0
                     *PosSaved     = 0
                  EndIf
                  Lines() = AddTabs(Tabs, MyTab) + Lines()
                  If CheckForEndTag(Lines(), b$)
                     If b$ = "if"
                        ;They have middletags!
                        LastElement(MTags())
                        AddElement(MTags())
                        MTags()\Name = b$
                        MTags()\Tabs = Tabs
                     ElseIf b$ = "select"
                        MiddleTagDepth << 1
                        MiddleTagFound & ($FFFFFFFF - MiddleTagDepth)
                        LastElement(MTags())
                        AddElement(MTags())
                        MTags()\Name = b$
                        MTags()\Tabs = Tabs
                     EndIf
                     Tabs + 1
                  EndIf
               Case 2
                  ;MiddleTags need special treatment
                  If LastElement(MTags())
                     If MTags()\Name = "if"
                        Tabs = MTags()\Tabs
                     ElseIf MTags()\Name = "select"
                        Tabs = MTags()\Tabs + 1
                        MiddleTagFound | MiddleTagDepth
                     EndIf
                  EndIf
                  If TabSaved > -1
                     If NumberOfLines > 1
                        EqualLines(*PosSaved, MaxPos, Lines())
                     EndIf
                     NumberOfLines = 0
                     TabSaved      = -1
                     MaxPos        = 0
                     *PosSaved     = 0
                  EndIf
                  Lines() = AddTabs(Tabs, MyTab) + Lines()
                  Tabs + 1
               Case 1
                  ;EndTag
                  Tabs - 1
                  ;Check for MiddleTags
                  If b$ = "endif" And LastElement(MTags()) And MTags()\Name = "if"
                     DeleteElement(MTags())
                  ElseIf b$ = "endselect" And LastElement(MTags()) And MTags()\Name = "select"
                     If MiddleTagFound & MiddleTagDepth
                        MiddleTagFound ! MiddleTagDepth
                        Tabs - 1
                     EndIf
                     DeleteElement(MTags())
                     MiddleTagDepth - 1
                  EndIf
                  If TabSaved > -1
                     If NumberOfLines > 1
                        EqualLines(*PosSaved, MaxPos, Lines())
                     EndIf
                     NumberOfLines = 0
                     TabSaved      = -1
                     MaxPos        = 0
                     *PosSaved     = 0
                  EndIf
                  Lines() = AddTabs(Tabs, MyTab) + Lines()
            EndSelect
            Break
         EndIf
      Next
      If Found = #False
         If b$ = "compilerif"
            AddElement(CD())
            CD()\KindOFDirective = #DIRECTIVE_COMPILERIF
            CD()\TabNum          = Tabs
         ElseIf b$ = "compilerselect"
            AddElement(CD())
            CD()\KindOFDirective = #DIRECTIVE_COMPILERSELECT
            CD()\TabNum          = Tabs
         ElseIf b$ = "compilercase" Or b$ = "compilerdefault"
            If ListIndex(CD()) > -1
               If CD()\KindOFDirective = #DIRECTIVE_COMPILERSELECT
                  ;O.k., first Compilercase
                  AddElement(CD())
                  CD()\KindOFDirective = #DIRECTIVE_COMPILERCASE
                  CD()\TabNum          = Tabs
                  Tabs + 1
               ElseIf CD()\KindOFDirective = #DIRECTIVE_COMPILERCASE
                  Tabs = CD()\TabNum + 1
               EndIf
            Else
               AddElement(CD())
               CD()\KindOFDirective = #DIRECTIVE_COMPILERCASE
               CD()\TabNum          = Tabs
               Tabs + 1
            EndIf
         ElseIf b$ = "compilerendselect"
            If ListIndex(CD()) > -1
               If CD()\KindOFDirective = #DIRECTIVE_COMPILERCASE
                  Tabs = CD()\TabNum
                  DeleteElement(CD())
               EndIf
            EndIf
            If ListIndex(CD()) > -1
               If CD()\KindOFDirective = #DIRECTIVE_COMPILERSELECT
                  Tabs = CD()\TabNum
                  DeleteElement(CD())
               EndIf
            EndIf
         ElseIf b$ = "compilerelse" Or b$ = "compilerelseif"
            If ListIndex(CD()) > -1
               If CD()\KindOFDirective = #DIRECTIVE_COMPILERIF
                  Tabs = CD()\TabNum
               EndIf
            EndIf
         ElseIf b$ = "compilerendif"
            If ListIndex(CD()) > -1
               If CD()\KindOFDirective = #DIRECTIVE_COMPILERIF
                  Tabs = CD()\TabNum
                  DeleteElement(CD())
               EndIf
            EndIf
         EndIf

         If Lines()
            If TabSaved > -1 And TabSaved <> Tabs
               If NumberOfLines > 1
                  EqualLines(*PosSaved, MaxPos, Lines())
               EndIf
               NumberOfLines = 0
               TabSaved      = -1
               MaxPos        = 0
               *PosSaved     = 0
            EndIf
            i = EqualPos(Lines())
            If i
               If *PosSaved = 0
                  *PosSaved     = @Lines()
                  TabSaved      = Tabs
                  NumberOfLines = 1
               Else
                  NumberOfLines + 1
               EndIf
               i + Len(MyTab) * Tabs
               If i > MaxPos
                  MaxPos = i
               EndIf
            Else
               If TabSaved > -1
                  If NumberOfLines > 1
                     EqualLines(*PosSaved, MaxPos, Lines())
                  EndIf
                  TabSaved  = -1
                  MaxPos    = 0
                  *PosSaved = 0
               EndIf
               NumberOfLines = 0
            EndIf
            Lines() = AddTabs(Tabs, MyTab) + Lines()
         Else
            ;Empty Line
            If TabSaved > -1
               If NumberOfLines > 1
                  EqualLines(*PosSaved, MaxPos, Lines())
               EndIf
               TabSaved  = -1
               MaxPos    = 0
               *PosSaved = 0
            EndIf
            NumberOfLines = 0
         EndIf
      EndIf
   Next

   Found = #PB_MessageRequester_Yes
   If Tabs <> 0
      ;Something wrong with the code...
      Found = MessageRequester("Error!", "Something wrong with your Code!" + #LF$ + "Would you like to parse it anyway ?", #PB_MessageRequester_YesNo)
   EndIf
   If Found = #PB_MessageRequester_Yes

      If CreateFile(0, a$)
         WriteStringFormat(0, UTF_Flag)
         ForEach Lines()
            WriteStringN(0, Lines(), UTF_Flag)
         Next
         CloseFile(0)
      EndIf

   EndIf
EndProcedure

Main()
End

DataSection
   Tags:
   ;StartTags
   Data.s "if"
   Data.s "while"
   Data.s "repeat"
   Data.s "procedure"
   Data.s "procedurec"
   Data.s "proceduredll"
   Data.s "procedurecdll"
   Data.s "enumeration"
   Data.s "enumerationbinary"
   Data.s "structure"
   Data.s "structureunion"
   Data.s "interface"
   Data.s "for"
   Data.s "foreach"
   Data.s "select"
   Data.s "datasection"
   Data.s "with"
   Data.s "import"
   Data.s "importc"
   Data.s "macro"
   Data.s "declaremodule"
   Data.s "module"
   Data.s ""
   ;MiddleTags
   Data.s "else"
   Data.s "elseif"
   Data.s "case"
   Data.s "default"
   Data.s ""
   ;EndTags
   Data.s "endif"
   Data.s "wend"
   Data.s "until"
   Data.s "forever"
   Data.s "endprocedure"
   Data.s "endstructure"
   Data.s "endstructureunion"
   Data.s "endinterface"
   Data.s "endenumeration"
   Data.s "next"
   Data.s "endselect"
   Data.s "enddatasection"
   Data.s "endwith"
   Data.s "endimport"
   Data.s "endmacro"
   Data.s "enddeclaremodule"
   Data.s "endmodule"
   Data.s ""
EndDataSection


Hier kann man die IDE-Einstellungen noch sehen.


Zuletzt geändert von HeX0R am 18.10.2017 21:42, insgesamt 12-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 10:44 
Offline
Benutzeravatar

Registriert: 21.07.2005 13:57
Wohnort: zu Hause
Ja, cool so ´n Quellcodeformatierer.

Ist der Quellcode öffentlich, falls man eigene Formatierungsvorlagen hat?

Gruß Karl

_________________
The Kopyright Liberation Front also known as the justified ancients of Mumu!
PB 5.X


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 11:34 
Offline
Benutzeravatar

Registriert: 10.09.2004 09:59
Wenn erwünscht klar.
Dann werde ich noch ein oder zwei Kommentare einfügen.
(Bin extrem Kommentarfaul)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 12:15 
Offline
Ein Admin
Benutzeravatar

Registriert: 29.08.2004 20:20
Wohnort: Saarbrücken
Das ist nur für die IDE, oder? Weil bei jaPBe gibt es schon zwei Methoden, die
automatisch einrücken. Ihren Unterschied hab ich aber bis heute noch nicht
erkannt.

_________________
Freakscorner.de - Der Bastelkeller | Neustes Video: Neje DK - 1 Watt Laser Engraver
Ubuntu Gnome 18.04.1 LTS x64, PureBasic 5.60 x64 (außerdem 4.41, 4.50, 4.61, 5.00, 5.10, 5.11, 5.21, 5.22, 5.30, 5.31, 5.40, 5.50)
"Die deutsche Rechtschreibung ist Freeware, du darfst sie kostenlos nutzen – Aber sie ist nicht Open Source, d. h. du darfst sie nicht verändern oder in veränderter Form veröffentlichen."


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 12:19 
Offline

Registriert: 10.11.2004 03:22
für fremdcode ist das sehr praktisch :allright:

...für eigenen brauch ich sowas nicht... ;)
ich würd nen knoten im kopp kriegen, wenn ich unstrukturiert proggen wollte...

_________________
... machts gut und danke für den fisch ...


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 12:32 
Offline
Benutzeravatar

Registriert: 08.09.2004 08:21
Wohnort: Amphibios 9
NicTheQuick hat geschrieben:
Das ist nur für die IDE, oder? Weil bei jaPBe gibt es schon zwei Methoden, die
automatisch einrücken. Ihren Unterschied hab ich aber bis heute noch nicht
erkannt.


Ausgangscode:
Code:
Enumeration
#lala = 1
#lululululululu = 2
EndEnumeration


Methode 1 (Ctrl + Tab):
Code:
Enumeration
  #lala = 1
  #lululululululu = 2
EndEnumeration


Methode 2 (Ctrl + Shift + Tab):
Code:
Enumeration
  #lala           = 1
  #lululululululu = 2
EndEnumeration


Grüße ... Kiffi

_________________
ƃᴉɹǝᴉʍɥɔs ʇsᴉ ɥɔɐɟuᴉǝ


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 12:35 
Offline
Benutzeravatar

Registriert: 10.09.2004 09:59
Jau, das ist nur für die PB-IDE, weil irgendjemand mal irgendwo sagte, JaPBe bringt das bereits mit.


Zuletzt geändert von HeX0R am 07.06.2009 23:14, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 16:42 
Offline
Benutzeravatar

Registriert: 08.09.2004 00:57
Wohnort: Berlin
:allright:
Ich wahr es schon leid immer jaPBe aufzurufen um die Forumspostings
lesbar zu machen :mrgreen:

Spart mir viel Zeit :D
(werde unformatierten Code jedoch trotztem weitgehend übersehen)

_________________
PureBasic 5.70 | SpiderBasic 2.10 | Windows 10 Pro (x64) | Linux Mint 19.0 (x64)
"Ich möchte gerne die Welt verändern, doch Gott gibt den Quellcode nicht frei."
Bild


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 17:49 
Offline
Benutzeravatar

Registriert: 06.10.2004 20:38
Wohnort: Bayreuth
Klasse! :allright:
Ich habe es mal für die PB4-Linux-IDE angepasst (es sind nur ein paar Zeilen, aber für die Faulen nochmal komplett):

Code:
 ;/---------------
 ;| IDE-Tool
 ;| Einrücker
 ;|
 ;| (c)HeX0R 2006
 ;| Do whatever you
 ;| like with this
 ;| source
 ;/---------------
 
 #TestIT = 0
 
 Structure _TAGS_
    Name.s
    Tabs.l
 EndStructure
 
 Procedure.s AddTabs(Tabs.l, Tab.s)
    Protected i.l, Result.s
 
    For i = 1 To Tabs
       Result + Tab
    Next i
 
    ProcedureReturn Result
 EndProcedure
 
 Procedure.s MyTrim(Line.s)
    ;Normal Trim() doesn't handle Tabs correctly, so i had to write my own
     
    Protected *B.BYTE, Start.l = 1, Ende.l, Result.s
 
    If Line = ""
       ProcedureReturn ""
    EndIf
 
    *B = @Line
    Repeat
       If *B\b <> 32 And *B\b <> 9 And *B\b <> 0
          Break
       EndIf
       Start + 1
       *B + 1
    ForEver
    Ende = Len(Line)
    *B = @Line + Ende - 1
    Ende - Start
    Repeat
       If *B\b <> 32 And *B\b <> 9 And *B\b <> 0
          Break
       EndIf
       Ende - 1
       *B - 1
    ForEver
    Result = Mid(Line, Start, Ende + 1)
 
    ProcedureReturn Result
 EndProcedure
 
 Procedure.s FindCommand(Line.s, Index.l)
    ;Find next Command in this Line
    ;When User wrote more then
    ;just one Command in one Line via ':'
    ;For Example
    ;While WindowEvent() : Wend
     
    Protected i.l, DQ.l, *B.CHARACTER, Result.s
 
    If Line = ""
       ProcedureReturn ""
    EndIf
 
    i  = 1
    *B = @Line
    While *B\c <> 0
       If *B\c = 34
          DQ ! 1
       EndIf
       If *B\c = ':' And DQ = 0
          If i = Index
             Break
          Else
             i + 1
          EndIf
       ElseIf i = Index
          Result + Chr(*B\c)
       EndIf
       *B + 1
    Wend
 
    ProcedureReturn MyTrim(Result)
 
 EndProcedure
 
 Procedure.l CheckForEndTag(b$, Tag.s)
    ;Checks, whether the Start and End-Tag is in one line
    ;For Example
    ;While WindowEvent() : Wend
    Protected a$, Result.l = #True, i.l = 2
 
    a$ = FindCommand(b$, i)
    While a$ <> ""
       Select StringField(LCase(a$), 1, " ")
          Case "endif"
             If Tag = "if"
                Result = #False
                Break
             EndIf
          Case "endselect"
             If Tag = "select"
                Result = #False
                Break
             EndIf
          Case "until"
             If Tag = "repeat"
                Result = #False
                Break
             EndIf
          Case "forever"
             If Tag = "repeat"
                Result = #False
                Break
             EndIf
          Case "next"
             If Tag = "for" Or Tag = "foreach"
                Result = #False
                Break
             EndIf
          Case "wend"
             If Tag = "while"
                Result = #False
                Break
             EndIf
          Case "enddatasection"
             If Tag = "datasection"
                Result = #False
                Break
             EndIf
          Case "endprocedure"
             If Tag = "procedure"
                Result = #False
                Break
             EndIf
          Case "endstructure"
             If Tag = "structure"
                Result = #False
                Break
             EndIf
          Case "endinterface"
             If Tag = "interface"
                Result = #False
                Break
             EndIf
          Case "endenumeration"
             If Tag = "enumeration"
                Result = #False
                Break
             EndIf
          Case "endwith"
             If Tag = "with"
                Result = #False
                Break
             EndIf
          Case "endimport"
             If Tag = "import"
                Result = #False
                Break
             EndIf
          Case "endmacro"
             If Tag = "macro"
                Result = #False
                Break
             EndIf
       EndSelect
       i + 1
       a$ = FindCommand(b$, i)
    Wend
 
    ProcedureReturn Result
 EndProcedure
 
 Procedure Main()
    Protected MyTab.s, a$, b$, Tabs.l, i.l, UTF_Start.l, Found.l, *index
 
    NewList Lines.s()
    NewList Tags._TAGS_()
    NewList MTags._TAGS_()
 
    OpenPreferences(GetEnvironmentVariable("HOME") + ".purebasic/purebasic.prefs")
    PreferenceGroup("Global")
    If ReadPreferenceLong("RealTab", 0)
       MyTab = #TAB$
    Else
       MyTab = Space(ReadPreferenceLong("TabLength", 2))
    EndIf
    ClosePreferences()
 
    a$ = ProgramParameter()
    If a$ = "" Or ReadFile(0, a$) = 0
    MessageRequester("nixgefunden", a$)
       End
    EndIf
 
    Tabs = 3
    Restore Tags
    Repeat
       Read b$
       If b$ = ""
          Tabs - 1
          If Tabs = 0
             Break
          EndIf
       Else
          AddElement(Tags())
          Tags()\Tabs = Tabs
          Tags()\Name = b$
       EndIf
    ForEver
 
    UTF_Start = #False
    i         = 0
 
    While Eof(0) = 0
       AddElement(Lines())
       b$ = MyTrim(ReadString(0))
       If i = 0
          If Asc(Mid(b$, 1, 1)) = 239 And Asc(Mid(b$, 2, 1)) = 187 And Asc(Mid(b$, 3, 1)) = 191
             ;UTF-Header
             UTF_Start = #True
             b$ = Right(b$, Len(b$) - 3)
          EndIf
       EndIf
       Lines() = b$
       i + 1
    Wend
    CloseFile(0)
    Tabs = 0
    ForEach Lines()
       b$ = LCase(StringField(StringField(Lines(), 1, " "), 1, "."))
       Found = #False
       ForEach Tags()
          If b$ = Tags()\Name
             Found = #True
             Select Tags()\Tabs
                Case 3
                   ;StartTag
                   Lines() = AddTabs(Tabs, MyTab) + Lines()
                   If CheckForEndTag(Lines(), b$)
                      If b$ = "if" Or b$ = "select"
                         ;They have middletags!
                         LastElement(MTags())
                         AddElement(MTags())
                         MTags()\Name = b$
                         MTags()\Tabs = Tabs
                      EndIf
                      Tabs + 1
                   EndIf
                Case 2
                   ;MiddleTags need special treetment
                   If LastElement(MTags())
                      If MTags()\Name = "if"
                         Tabs = MTags()\Tabs
                      ElseIf MTags()\Name = "select"
                         Tabs = MTags()\Tabs + 1
                      EndIf
                   EndIf
                   Lines() = AddTabs(Tabs, MyTab) + Lines()
                   Tabs + 1
                Case 1
                   ;EndTag
                   Tabs - 1
                   ;Check for MiddleTags
                   If b$ = "endif" And LastElement(MTags()) And MTags()\Name = "if"
                      DeleteElement(MTags())
                   ElseIf b$ = "endselect" And LastElement(MTags()) And MTags()\Name = "select"
                      Tabs - 1
                      DeleteElement(MTags())
                   EndIf
                   Lines() = AddTabs(Tabs, MyTab) + Lines()
             EndSelect
             Break
          EndIf
       Next
       If Found = #False
          If Lines()
             Lines() = AddTabs(Tabs, MyTab) + Lines()
          EndIf
       EndIf
    Next
 
    Found = #PB_MessageRequester_Yes
    If Tabs <> 0
       ;Something wrong with the code...
       Found = MessageRequester("Error!", "Something wrong with your Code!" + #LF$ + "Would you like to parse it anyway ?", #PB_MessageRequester_YesNo)
    EndIf
    If Found = #PB_MessageRequester_Yes
 
       CompilerIf #TestIt = 0
 
       If CreateFile(0, a$)
          ForEach Lines()
             If UTF_Start
                WriteByte(0, 239)
                WriteByte(0, 187)
                WriteByte(0, 191)
                UTF_Start = #False
             EndIf
             WriteStringN(0, Lines())
          Next
          CloseFile(0)
       EndIf
 
       CompilerElse
 
       a$ = "[code]" + #CRLF$
       If LastElement(Lines())
          While Left(MyTrim(Lines()), 1) = ";"
             *index = @Lines()
             If PreviousElement(Lines()) = 0
                Break
             EndIf
          Wend
       EndIf
       ForEach Lines()
          If @Lines() = *index
             Break
          EndIf
          a$ + Lines() + #CRLF$
       Next
       a$ + "[/code]"
       SetClipboardText(a$)
 
       CompilerEndIf
 
    EndIf
 EndProcedure
 
 Main()
 End
 
 DataSection
    Tags:
    ;StartTags
    Data.s "if"
    Data.s "while"
    Data.s "repeat"
    Data.s "procedure"
    Data.s "proceduredll"
    Data.s "enumeration"
    Data.s "structure"
    Data.s "interface"
    Data.s "for"
    Data.s "foreach"
    Data.s "select"
    Data.s "datasection"
    Data.s "with"
    Data.s "import"
    Data.s "macro"
    Data.s ""
    ;MiddleTags
    Data.s "else"
    Data.s "elseif"
    Data.s "case"
    Data.s "default"
    Data.s ""
    ;EndTags
    Data.s "endif"
    Data.s "wend"
    Data.s "until"
    Data.s "forever"
    Data.s "endprocedure"
    Data.s "endstructure"
    Data.s "endinterface"
    Data.s "endenumeration"
    Data.s "next"
    Data.s "endselect"
    Data.s "enddatasection"
    Data.s "endwith"
    Data.s "endimport"
    Data.s "endmacro"
    Data.s ""
 EndDataSection

Gibt es eine Möglichkeit, das Tool auch funktionieren zu lassen, wenn der Code noch nicht gespeichert ist?

_________________
Nicht durch Zorn, sondern durch Lachen tötet man
ClipGrab | Pastor - jetzt mit kurzen URLs!


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags:
BeitragVerfasst: 19.10.2006 18:05 
Offline
Benutzeravatar

Registriert: 10.09.2004 09:59
Da ich %TEMPFILE übergeben lasse, sollte es eigentlich auch mit ungespeichertem Code funktionieren.
Zumindest bei mir hier unter Win tut es das, unter Linux etwa nicht ?


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 55 Beiträge ]  Gehe zu Seite 1, 2, 3, 4, 5, 6  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye