; the orginal source by MrMat, Sat Feb 11, 2006
; http://www.purebasic.fr/english/viewtopic.php?t=19418&highlight=scintilla
; modified by waffle, Jan 2008 as a DBC 113+ Lexer Container
; www.archonrpg.com

If InitScintilla("Scintilla.dll")=0
  MessageRequester("Error","No Scintilla.dll",#MB_ICONSTOP)
  End
EndIf
XIncludeFile "SciLexer2.pbi"

;Modified to see if PB does this directly

;- Constants
Global RunPath.s
Global TipsDone.l
Global TheTip.s
Global ThreadActive.l
Global MaxKey.l


RunPath=GetPathPart(ProgramFilename() )

Enumeration
  #LexerState_Space         ; default text
  #LexerState_Comment       ; comment text
  #LexerState_Text          ; "text
  #LexerState_EndText       ; text"
  #LexerState_Keyword       ; possible keyword, requires testing
  #LexerState_DBCKeyword    ; confirmed keyword
  #LexerState_FoldKeyword   ; keyword that is a fold point
  #LexerState_GoodBrace     ; () pair
  #LexerState_BadBrace      ; ( or ) ... no match
  #LexerState_Remstart      ; remstart flag
EndEnumeration

;- Load KeyWords
Structure KeyStruct
  KeyWord.s                 ; lower case of original keyword
  KeyTip.s                  ; tip ripped from htm help file
  KeyLink.s                 ; link to htm file
  MixKey.s                  ; mixed case "Set Object"
  KeyLength.l               ; length of keyword ... to catch the space in keyword
  Fold.l                    ; 0,1,-1 ... no folding,1 fold point,-1 end fold point
EndStructure
Global NewList Key.KeyStruct()
Global NewList Key2.KeyStruct()

;- declares
Declare Highlight(ID, startpos,endpos.l)

Procedure SaveTips()
  F.l=CreateFile(#PB_Any,RunPath+"keylist.txt")
  If F
    ForEach Key2()
      WriteStringN(F,Key2()\KeyWord)
      WriteStringN(F,Key2()\KeyTip)
      WriteStringN(F,Key2()\KeyLink)
    Next Key2()
    CloseFile(F)
  EndIf
EndProcedure

Procedure GetTips()
  ;This scans the htm file specified in the link for the syntax
  ForEach Key2()
    If Key2()\KeyLink
      F.l=ReadFile(#PB_Any,Key2()\KeyLink)
      If F
        Repeat
          key2()\KeyTip=ReadString(F)
          If FindString(Key2()\KeyTip,"SYNTAX",1)
            Repeat
              key2()\KeyTip=ReadString(F)
              If Left(Key2()\KeyTip,1)<>"<"
                Break
              EndIf            
            Until Eof(F)
            Repeat
              T2.s=ReadString(F)
              If LCase(Left(T2,Key2()\KeyLength))=Key2()\KeyWord
                If LCase(Left(Key2()\KeyTip,Key2()\KeyLength))=Key2()\KeyWord
                  If Left(T2,1)<>"<" And Len(T2)>Len(Key2()\KeyTip)
                    Key2()\KeyTip=T2
                    Break
                  EndIf
                Else
                  Key2()\KeyTip=T2
                  Break
                EndIf
              EndIf
            Until Eof(F)
            For N=1 To Len(Key2()\KeyTip)
              If Mid(Key2()\KeyTip,N,1)="<"
                Key2()\KeyTip=Left(Key2()\KeyTip,N-1)
                Break
              EndIf
            Next n
            Break
          EndIf
          Key2()\KeyTip=""
        Until Eof(F)
        CloseFile(F)
      EndIf
    EndIf
  Next Key2()
  
EndProcedure
Procedure GetLinks(Null.l)
  ;this scans the index.htm file for keywords
  ;and retreives the links ....
  HPath.s=GetPathPart(ProgramFilename())
  F.l=ReadFile(#PB_Any,"index.htm")
  If F=0
    FN.s=OpenFileRequester("Locate DBC Help file 'index.htm'","index.htm","*.htm|*.htm;*.html|All (*.*)|*.*",0)
    If FN
      F=ReadFile(#PB_Any,FN)
      HPath=GetPathPart(FN)
    EndIf
  EndIf
  If F=0
    ProcedureReturn
  EndIf
  tag.s="<a href="
  tagL.l=Len(tag)  
  Repeat
    link.s=ReadString(F)
    If LCase(Left(link,tagl))=tag
      ;this is a link ... maybe to a keyword
      ;retrieve the link
      fulllink.s=HPath
      For n=tagl+2 To Len(link)
        C.s=Mid(link,n,1)
        If C=Chr(34)
          Break
        EndIf
        fulllink=fulllink+C
      Next n
      
      ;locate the keyword part
      keyword.s=""
      For z=n+2 To Len(link)
        C.s=Mid(link,z,1)
        If C="<"
          Break
        EndIf
        keyword=keyword+C
      Next z
      ;finally, locate the keyword
      keyword=LCase(keyword)
      
      ForEach Key2()
        If Key2()\keyword=keyword
          Key2()\KeyLink=FullLink
          Break
        EndIf
      Next Key2()
    EndIf
  Until Eof(F)
  CloseFile(F)
  
  ;now the tips
  GetTips()
  SaveTips()
  TipsDone = 1
  
EndProcedure

Procedure LoadKeyWords()
  F.l=ReadFile(#PB_Any,RunPath+"keylist.txt")
  DoneList.l=0
  If F=0
    FN.s=OpenFileRequester("Locate Keywords.txt file","keywords.txt","*.txt|*.txt|All (*.*)|*.*",0)
    If FN
      F.l=ReadFile(#PB_Any,FN)
    EndIf
  Else
    DoneList.l=1
  EndIf
  If F=0
    MessageRequester("Scitilla3","Unable to load keywords file",0)
    End
  EndIf
  Repeat
    K.s=ReadString(F)
    If K
      AddElement(Key())    
      If Right(K,1)=")"
        K=Left(K,Len(K)-2)
      EndIf
      Key()\KeyWord=LCase(K)
      Key()\KeyLength=Len(K)
      If DoneList
        ;load full structure from list
        ;KeyWord.s                  ; lower case of original keyword
        Key()\KeyTip=ReadString(F)  ; tip ripped from htm help file
        Key()\KeyLink=ReadString(F) ; link to htm file
        ;MixKey.s                   ; mixed case "Set Object"
        ;KeyLength.l                ; length of keyword ... to catch the space in keyword
        ;Fold.l                     ; 0,1,-1 ... no folding,1 fold point,-1 end fold point
      EndIf
      ;check fold points
      If Key()\KeyWord="function"
        Key()\Fold=1
      ElseIf Key()\KeyWord="endfunction"
        Key()\Fold=-1
      ElseIf Key()\KeyWord="do"
        Key()\Fold=1
      ElseIf Key()\KeyWord="loop"
        Key()\Fold=-1
      ElseIf Key()\KeyWord="for"
        Key()\Fold=1
      ElseIf Key()\KeyWord="next"
        Key()\Fold=-1
      ElseIf Key()\KeyWord="while"
        Key()\Fold=1
      ElseIf Key()\KeyWord="endwhile"
        Key()\Fold=-1
      ElseIf Key()\KeyWord="repeat"
        Key()\Fold=1
      ElseIf Key()\KeyWord="until"
        Key()\Fold=-1
      ElseIf Key()\keyword="remstart"
        Key()\fold=1
      ElseIf Key()\keyword="remend"
        key()\fold=-1
      ElseIf Key()\keyword="select"
        Key()\fold=1
      ElseIf Key()\keyword="endselect"
        key()\fold=-1
      ElseIf Key()\keyword="case"
        Key()\fold=1
      ElseIf Key()\keyword="case default"
        Key()\fold=1      
      ElseIf Key()\keyword="endcase"
        key()\fold=-1
      EndIf
      UFlag.l=0
      For n=1 To Len(K)
        C.s=Mid(K,n,1)
        If C=" "
          UFlag=1
        Else
          If UFlag
            C=LCase(C)          
          Else
            C=UCase(C)
            UFlag=1
          EndIf
        EndIf
        Key()\MixKey=key()\MixKey+C
      Next n    
    EndIf
  Until Eof(F)
  CloseFile(F)
  ;sort in descending order by keyword length
  SortStructuredList(Key(),1,OffsetOf(KeyStruct\KeyLength),#PB_Sort_Long)
  FirstElement(Key())
  MaxKey=Key()\KeyLength+10
  If DoneList=0
    ;copy list
    ForEach Key()
      AddElement(Key2())
      Key2()\KeyWord=Key()\KeyWord
    Next Key()
    CreateThread(@GetLinks(),0)
  Else
    TipsDone=2
  EndIf
EndProcedure

Declare ThreadHighlight(Last.l)
Procedure SCI_LoadFile(ID,filename.s)
  ;filename.s = OpenFileRequester("Open a file...", "", "PureBasic (*.pb)|*.pb|All files (*.*)|*.*", 0)
  If filename <> ""
    file.l = ReadFile(#PB_Any, filename)
    If file <> 0
      len.l = Lof(file)
      *mem = AllocateMemory(len+2)
      If *mem
        ReadData(file, *mem, len)        
        SCI_ClearAll(ID)
        SCI_SetText(ID, *mem)
        FreeMemory(*mem)
        SCI_SetCursor(ID,#SC_CURSORWAIT)
        HighLight(ID,0,len)
        SCI_SetCursor(ID,#SC_CURSORNORMAL)        
      EndIf
      CloseFile(file)
    EndIf
  EndIf
EndProcedure

Procedure SCI_SaveFile(ID,filename.s)
  ;filename.s = SaveFileRequester("Save a file...", "", "PureBasic (*.pb)|*.pb|All files (*.*)|*.*", 0)
  If filename <> ""
    file.l = CreateFile(#PB_Any, filename)
    If file <> 0
      len.l = SCI_GetLength(ID) + 1
      *mem = AllocateMemory(len)
      If *mem
        SCI_GetText(ID, len, *mem)
        WriteData(file, *mem, len)
        FreeMemory(*mem)
      EndIf
      CloseFile(file)
    EndIf
  EndIf
EndProcedure

Procedure.l DBC_FindText(ID,text.s)
  ;text.s = InputRequester("Scintilla test", "Enter text to search for", "")
  start.l=-1
  If text <> ""
    current.l = SCI_GetCurrentPos(ID)
    SCI_SetAnchor(ID, current)
    SCI_SearchAnchor(ID)
    start.l = SCI_SearchNext(ID, 0, @text)
    If start <> -1      
      Anchor.l = SCI_GetAnchor(ID)
      SCI_SetSel(ID, start, Anchor)          
    EndIf
  EndIf
  SetActiveGadget(ID)
  ProcedureReturn start
EndProcedure

Procedure DBC_GotoLine(ID,lineno.l)
  ;line.s = InputRequester("Scintilla test", "Enter line to go to", "1")
  ;lineno.l = Val(line)
  If lineno > 0
    SCI_GotoLine(ID, lineno - 1)
  EndIf
  SetActiveGadget(ID)
EndProcedure

Procedure ToggleCurrentFold(ID)
  Pos.l = SCI_GetCurrentPos(ID)
  line.l = SCI_LineFromPosition(ID, Pos)
  SCI_ToggleFold(ID, line)
EndProcedure

Procedure.l IsClear(A.c)
  ;return is non-zero
  ;if A is not a valid char
  If A=''
    ProcedureReturn 1
  ElseIf A<'!'
    ProcedureReturn 1
  ElseIf A<'('
    ProcedureReturn 0
  ElseIf A<'0'
    ProcedureReturn 1
  ElseIf A<':'
    ProcedureReturn 0
  ElseIf A<'A'
    ProcedureReturn 1
  ElseIf A<'['
    ProcedureReturn 0
  ElseIf A<'_'
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

Procedure Highlight(ID, startpos,endpos.l)
  ;standard preparation stuff here
  ;to calculate or confirm start char and end char positions
  ;these can even be on multiple lines .....
  
  If startpos<0
    endstyled.l = SCI_GetEndStyled(ID)
    linenumber.l = SCI_LineFromPosition(ID, endstyled)
  Else
    linenumber=SCI_LineFromPosition(ID,startpos)
  EndIf
  If linenumber = 0
    Level = #SC_FOLDLEVELBASE
  Else
    ;linenumber - 1
    Level = SCI_GetFoldLevel(ID, linenumber) & ~ #SC_FOLDLEVELHEADERFLAG
  EndIf
  
  ;LVL.l=FVL+SCI_linesOnScreen(ID)+1
  
  
  thislevel.l = Level
  nextlevel.l = Level
  
  CurrentPos.l = SCI_PositionFromLine(ID, linenumber)
  
  
  FirstPos=CurrentPos
  ;CurrentPos=start of line char
  SCI_StartStyling(ID, CurrentPos, $1F | #INDICS_MASK)
  state = #LexerState_Space
  startkeyword = CurrentPos
  ;for remstart, we need to check the style of prev position
  
  
  If CurrentPos>0
    state=SCI_GetStyleAt(ID,CurrentPos-1)
    If state<>#LexerState_Remstart
      state=#LexerState_Space
    EndIf
  EndIf
  
  ;we also need the mouse location  
  mouse.l=SCI_GetCurrentPos(ID)
  
  ;- HighLight Loop, check char
  
  longflag.l=0
  While CurrentPos <= endpos
    ;Debug "Current Pos = "+Str(CurrentPos)
    ;Debug "Prev state = "+Str(state)    
    Char.l = SCI_GetCharat(ID, CurrentPos)
    ;Debug "Char = "+Chr(Char)
    
    oldstate = state
    If state<>#Lexerstate_RemStart
      ;Char.l = SCI_GetCharat(ID, CurrentPos)
      ;see if char changes current state    
      If Char = '`'
        state = #LexerState_Comment
        If oldstate<>state
          oldstate=#LexerState_Space
        EndIf
      ElseIf char = 34
        If state <> #LexerState_COmment
          If state <> #LexerState_Text
            state = #LexerState_Text
            oldstate=#LexerState_Space
          Else          
            state = #LexerState_EndText          
          EndIf  
        EndIf
      ElseIf Char = 10
        state=#LexerState_Space
      ElseIf Char = 13
        state=#LexerState_Space    
      ElseIf state<>#LexerState_Comment
        If state<>#Lexerstate_Text
          If char = '#' Or '$'
            state=#LexerState_KeyWord
          ElseIf Char = '(' Or Char = ')'          
            state=#LexerState_Space
          ElseIf Char = 9 Or Char = '.'
            state = #LexerState_Space
          ElseIf Char>' ' And Char<'A'
            state = #LexerState_Space
          ElseIf Char>'Z' And char<'a'
            state = #LexerState_Space
          ElseIf Char>'z'
            state = #LexerState_Space
          ElseIf Char=' '
            ;spacekey just continues previous state
            state=oldstate
            If TipsDone=1
              ;- copy the list to the keywords
              ;placed here to reduce checks
              ResetList(Key2())
              ResetList(Key())
              While NextElement(Key())
                NextElement(Key2())
                Key()\KeyLink=Key2()\KeyLink
                Key()\KeyTip=key2()\KeyTip
              Wend
              TipsDone=2
              ClearList(Key2())
            EndIf
          Else
            ;flag to check for context
            state = #LexerState_Keyword
            If CurrentPos=StartPos
              oldstate=state
            EndIf      
          EndIf
        EndIf    
      EndIf    
    EndIf
    
    If oldstate<>state
      If Oldstate<>#LexerState_Keyword
        ;style needs changing
        SCI_SetStyling(ID, CurrentPos - startkeyword, oldstate)
        startkeyword=CurrentPos
        ;Debug "Last Style = "+Str(oldstate)
        ;Debug "CurrentPos = "+Chr(SCI_GetCharAt(0,CurrentPos))
      ElseIf 1=0
        ;- check for keyword match
        
        found.l=0
        ForEach Key()
          ;assumes startkeyword is the valid start point
          ;tr.TEXTRANGE\chrg\cpmin=startkeyword
          ;tr\chrg\cpmax=startkeyword+Key()\KeyLength
          ;keyword.s=Space(key()\KeyLength)
          ;tr\lpstrText=@keyword
          ;keylength=SCI_GetTextRange(0,tr)
          ;If LCase(keyword)=key()\keyword
          
          ;this method makes no assumptions
          ;tr.TEXTRANGE\chrg\cpmin=CurrentPos-Key()\KeyLength
          tr.TEXTRANGE\chrg\cpmin=CurrentPos
          tr\chrg\cpmax=CurrentPos+Key()\KeyLength
          keyword.s=""
          keyword=Space(2*Key()\KeyLength+4)
          tr\lpstrText=@keyword
          keylength=SCI_GetTextRange(ID,tr)
          FP.l=FindString(LCase(keyword),key()\KeyWord,1)
          
          ;verify keywords not toutching          
          If FP>1            
            If IsClear(Asc(Mid(keyword,FP-1,1)))=0
              FP=0
            ElseIf CurrentPos+FP+1-Key()\KeyLength<EndPos
              If IsClear(SCI_GetCharAT(ID,CurrentPos+FP+1-Key()\KeyLength))=0
                FP=0
              EndIf
            EndIf
          ElseIf FP=1
            If CurrentPos-Key()\KeyLength-1>=StartPos
              If IsClear(SCI_GetCharAT(ID,CurrentPos-Key()\KeyLength-1))=0
                FP=0
              Else
                If IsClear(Asc(Mid(keyword,Key()\KeyLength+1,1)))=0
                  FP=0
                EndIf
              EndIf
            EndIf
          EndIf
          
          If FP
            newstart.l=(CurrentPos-Key()\KeyLength)+FP-1
            If newstart>StartKeyword
              SCI_SetStyling(ID,newstart-StartKeyword,#LexerState_Space)
              StartKeyWord=newstart
            EndIf           
            If Key()\Fold
              SCI_SetStyling(ID,key()\KeyLength,#LexerState_FOLDKeyword)
              thislevel | #SC_FOLDLEVELHEADERFLAG
              nextlevel + key()\Fold
            Else
              SCI_SetStyling(ID,key()\KeyLength,#LexerState_DBCKeyword)
            EndIf
            ;- show tip
            If mouse>=startkeyword
              If mouse<=startkeyword + Key()\KeyLength                
                StatusBarText(GetGadgetData(ID),0,Key()\KeyTip)
                
                TheTip=Key()\KeyLink
              EndIf
            EndIf            
            startkeyword + Key()\KeyLength
            Currentpos=startkeyword
            ;startkeyword +1                      
            found.l=1
            
            Break
          EndIf
        Next Key()
        
        If found=0
          SCI_SetStyling(ID, CurrentPos - startkeyword, #LexerState_Space)
          startkeyword=CurrentPos
        EndIf
        
      EndIf
    Else
      ;- realtime highlighting
      If oldstate=#LexerState_Keyword
        ;currentpos is always off by 1 char ....
        ;so it points to the second char in the keyword
                 
        ;tr.TEXTRANGE\chrg\cpmin=CurrentPos-MaxKey
        tr.TEXTRANGE\chrg\cpmin=CurrentPos - 2
        If tr\chrg\cpmin<StartPos
          tr\chrg\cpmin=StartPos
        EndIf
        tr\chrg\cpmax=CurrentPos+MaxKey         
        If tr\chrg\cpmax>EndPos
          tr\chrg\cpmax=EndPos
        EndIf
        keyword.s=""
        keyword=Space(MaxKey+6)
        tr\lpstrText=@keyword
        keylength=SCI_GetTextRange(ID,tr)
        keyword=LCase(keyword)
        ;Debug "Prepare to search"
        ;Debug "tr\chrg\cpmin = "+Str(tr\chrg\cpmin)
        ;Debug "tr\chrg\cpmax = "+Str(tr\chrg\cpmax)
        ;Debug "StartPos ="+Str(StartPos)
        ;Debug "EndPos ="+Str(EndPos)
        ;Debug "CharAT = "+Chr(SCI_GetCharAt(0,CurrentPos))
        ;Debug keyword
        
        ForEach Key()
          ;assumes startkeyword is the valid start point
          ;tr.TEXTRANGE\chrg\cpmin=startkeyword
          ;tr\chrg\cpmax=startkeyword+Key()\KeyLength
          ;keyword.s=Space(key()\KeyLength)
          ;tr\lpstrText=@keyword
          ;keylength=SCI_GetTextRange(0,tr)
          ;If LCase(keyword)=key()\keyword
          
          ;this method makes no assumptions          
          
          ;FPM.l=FindString(LCase(keyword),key()\KeyWord,1)
          ;If FPM
          ;  Debug "Findstring reports "+Str(FPM)+" = "+Key()\Keyword
          ; 
          ;EndIf
          FP.l=0
          If tr\chrg\cpmin=StartPos
            If Left(keyword,key()\KeyLength)=Key()\Keyword             
              FP=1
            EndIf
          Else
            If Mid(keyword,2,key()\KeyLength)=key()\Keyword
              If IsClear(Asc(Left(Keyword,1)))
                FP=2
              EndIf
            EndIf
          EndIf
          If FP
            If tr\chrg\cpmax>tr\chrg\cpmin+Key()\KeyLength+FP
              If IsClear(Asc(Mid(Keyword,FP+Key()\KeyLength,1)))=0
                FP=0
              EndIf
            EndIf
          EndIf
                    
          If FP
            newstart.l=tr\chrg\cpmin+FP-1
            If newstart>StartKeyword
              SCI_SetStyling(ID,newstart-StartKeyword,#LexerState_Space)
              StartKeyWord=newstart
            EndIf           
            If Key()\Fold
              If Key()\Keyword="remstart"
                SCI_SetStyling(ID,Key()\KeyLength,#LexerState_RemStart)
                state=#Lexerstate_RemStart
              Else
                SCI_SetStyling(ID,key()\KeyLength,#LexerState_FOLDKeyword)
              EndIf
              thislevel | #SC_FOLDLEVELHEADERFLAG
              nextlevel + key()\Fold
            Else
              If Key()\Keyword="rem"
                SCI_SetStyling(ID,key()\KeyLength,#LexerState_Comment)
                state=#LexerState_Comment
              Else
                SCI_SetStyling(ID,key()\KeyLength,#LexerState_DBCKeyword)
              EndIf
            EndIf
            ;- show tip
            If mouse>=startkeyword
              If mouse<=startkeyword + Key()\KeyLength
                StatusBarText(GetGadgetData(ID),0,Key()\KeyTip)
                TheTip=Key()\KeyLink
              EndIf
            EndIf            
            startkeyword + Key()\KeyLength
            Currentpos=startkeyword
            ;startkeyword +1                      
            found.l=1
            ;Debug "Found"
            Break
          EndIf
        Next Key() 
        ;- remstart 
      ElseIf state=#LexerState_RemStart
        ;look for remend keyword
        tr.TEXTRANGE\chrg\cpmin=CurrentPos - 2
        If tr\chrg\cpmin<StartPos
          tr\chrg\cpmin=StartPos
        EndIf
        tr\chrg\cpmax=CurrentPos+MaxKey         
        If tr\chrg\cpmax>EndPos
          tr\chrg\cpmax=EndPos
        EndIf
        keyword.s=""
        keyword=Space(MaxKey+6)
        tr\lpstrText=@keyword
        keylength=SCI_GetTextRange(ID,tr)
        keyword=LCase(keyword)
        FP.l=0
        If tr\chrg\cpmin=StartPos
          If Left(keyword,6)="remend"
            FP=1
          EndIf
        Else
          If Mid(keyword,2,6)="remend"
            If IsClear(Asc(Left(Keyword,1)))
              FP=2
            EndIf
          EndIf
        EndIf
        If FP
          If tr\chrg\cpmax>tr\chrg\cpmin+6+FP
            If IsClear(Asc(Mid(Keyword,FP+6,1)))=0
              FP=0
            EndIf
          EndIf
        EndIf
        If FP
          newstart.l=tr\chrg\cpmin+FP-1
          If newstart>StartKeyword
            SCI_SetStyling(ID,newstart-StartKeyword,#LexerState_RemStart)
            StartKeyWord=newstart
          EndIf           
          SCI_SetStyling(ID,8,#LexerState_Comment)
          thislevel | #SC_FOLDLEVELHEADERFLAG
          nextlevel -1
                 
                      
          startkeyword + 6
          Currentpos=startkeyword
          ;startkeyword +1                      
          found.l=1
           
          state = #LexerState_Comment           
        Else
          SCI_SetStyling(ID,CurrentPos-StartKeyword,#LexerState_RemStart)
          StartKeyWord=CurrentPos
        EndIf
      EndIf      
    EndIf
    ;- update fold
    If Char = 10 Or CurrentPos = endpos
      SCI_SetFoldLevel(ID, linenumber, thislevel)
      thislevel = nextlevel
      linenumber + 1
    EndIf
    
    CurrentPos + 1
  Wend
  
          
EndProcedure

Procedure ScintillaWindowCallback(ID,*notify.SCNotification)
  *lpnmhdr.NMHDR = *notify\nmhdr
      
  Select *lpnmhdr\code
    Case #SCN_UPDATEUI
      mouse.l=SCI_GetCurrentPos(ID)
      char=SCI_GetCharAt(ID,mouse)      
      If char='(' Or char=')'
        Pos2.l=SCI_BraceMatch(ID,mouse)
        If Pos2>=0
          SCI_BraceHighlight(ID,mouse,Pos2)
        Else
          SCI_BraceBadLight(ID,mouse)
        EndIf
      EndIf
    Case #SCN_STYLENEEDED
      Highlight(ID,-1,*notify\Position)
    Case #SCN_MARGINCLICK
      modifiers = *notify\modifiers
      Position = *notify\Position
      margin = *notify\margin
      linenumber = SCI_LineFromPosition(ID, Position)
      Select margin
        Case 2
          SCI_ToggleFold(ID, linenumber)
      EndSelect
  EndSelect
  
  
EndProcedure

Procedure SCI_SetStylesDBC(ID)
  SCI_SetLexer(ID, #SCLEX_CONTAINER)
  
  ;- Set default font
  SCI_SetTabWidth(ID,2)
  SCI_StyleSetFont(ID, #STYLE_DEFAULT, @"Courier New")
  SCI_StyleSetSize(ID, #STYLE_DEFAULT, 16)
  SCI_StyleClearAll(ID)
  
  ;- Set caret line colour
  SCI_SetCaretLineBack(ID, $EEEEFF)
  SCI_SetCaretLineVisible(ID, #True)
  
  ;- Set styles for custom lexer
  SCI_StyleSetFore(ID, #LexerState_Comment, $BB00)
  SCI_StyleSetFore(ID, #LexerState_RemStart, $BB00)
  SCI_StyleSetItalic(ID, #LexerState_RemStart, 1)
  SCI_StyleSetItalic(ID, #LexerState_Comment, 1)
  SCI_StyleSetFore(ID, #LexerState_Text, RGB(0,0,255))
  SCI_StyleSetFore(ID, #LexerState_EndText, RGB(0,0,255))
  SCI_StyleSetFore(ID, #LexerState_Keyword, 0)
  SCI_StyleSetFore(ID, #LexerState_DBCKeyword, $FF)
  SCI_StyleSetCase(ID, #LexerState_DBCKeyword,1)
  SCI_StyleSetFore(ID, #LexerState_FoldKeyword, $FF)
  SCI_StyleSetCase(ID, #LexerState_FoldKeyword,1)
  SCI_StyleSetFore(ID, #STYLE_BRACELIGHT, RGB(0,0,255))
  SCI_StyleSetBold(ID, #STYLE_BRACELIGHT,0)
  SCI_StyleSetFore(ID, #STYLE_BRACEBAD,RGB(255,0,0))
  SCI_StyleSetBold(ID, #STYLE_BRACEBAD,0)
  ;SCI_StyleSetFore(ID, #LexerState_GoodBrace,RGB(0,0,255))
  ;SCI_StyleSetBold(ID, #LexerState_GoodBrace,0)
  ;SCI_StyleSetFore(ID, #LexerState_BadBrace,RGB(0,0,255))
  ;SCI_StyleSetBold(ID, #LexerState_BadBrace,0)

  ;- Margins
  SCI_SetMarginTypen(ID, 0, #SC_MARGIN_NUMBER)
  SCI_SetMarginMaskN(ID, 2, #SC_MASK_FOLDERS)
  SCI_SetMarginWidthN(ID, 0, 70)
  SCI_SetMarginWidthN(ID, 2, 20)
  SCI_SetMarginSensitiveN(ID, 2, #True)
  
  ;- Choose folding icons
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDEROPEN, #SC_MARK_CIRCLEMINUS)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDER, #SC_MARK_CIRCLEPLUS)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDERSUB, #SC_MARK_VLINE)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDERTAIL, #SC_MARK_LCORNERCURVE)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDEREND, #SC_MARK_CIRCLEPLUSCONNECTED)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDEROPENMID, #SC_MARK_CIRCLEMINUSCONNECTED)
  SCI_MarkerDefine(ID, #SC_MARKNUM_FOLDERMIDTAIL, #SC_MARK_TCORNERCURVE)
  
  ;- Choose folding icon colours
  SCI_MarkerSetFore(ID, #SC_MARKNUM_FOLDER, $FFFFFF)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDER, 0)
  SCI_MarkerSetFore(ID, #SC_MARKNUM_FOLDEROPEN, $FFFFFF)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDEROPEN, 0)
  SCI_MarkerSetFore(ID, #SC_MARKNUM_FOLDEROPENMID, $FFFFFF)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDEROPENMID, 0)
  SCI_MarkerSetFore(ID, #SC_MARKNUM_FOLDERSUB, $FFFFFF)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDERSUB, 0)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDERTAIL, 0)
  SCI_MarkerSetBack(ID, #SC_MARKNUM_FOLDERMIDTAIL, 0)
  
  SCI_SetEdgeMode(ID,#EDGE_BACKGROUND)
  SCI_SetEdgeColumn(ID,128)
  SCI_SetEdgeColour(ID,RGB(128,0,0))
  
EndProcedure

;- Window
Procedure SCI_Test()
  LoadKeyWords()
  OpenWindow(0, #PB_Ignore, 0, 600, 440, "Scintilla example")
  
  CreateMenu(0, WindowID(0))
  MenuTitle("File")
  MenuItem(1, "Open...")
  MenuItem(2, "Save As...")
  MenuItem(3, "Quit")
  MenuTitle("Edit")
  MenuItem(4, "Find...")
  MenuItem(5, "Goto...")
  MenuItem(6, "Toggle current fold")
  MenuItem(7, "ViewLink")
  
  CreateGadgetList(WindowID(0))
  
  ScintillaGadget(0, 0, 0, 600, 400,@ScintillaWindowCallback()) 
  SetGadgetData(0,0)
  CreateStatusBar(0,WindowID(0))
  AddStatusBarField(600)
  
  SCI_SetStylesDBC(0)

  ;- Set some sample text
  text.s = "` A custom Scintilla lexer example" + #CRLF$
  text + "Function hello()" + #CRLF$
  text + "  Debug(" + Chr(34) + "Woo" + Chr(34) + ")" + #CRLF$
  text + "EndFunction"
  SetGadgetText(0, text)
  
  RemoveKeyboardShortcut(0, #PB_Shortcut_Tab)
  RemoveKeyboardShortcut(0, #PB_Shortcut_Tab | #PB_Shortcut_Shift)

  quit.l = #False
  ;- Main Loop
  Repeat
    event.l = WaitWindowEvent()
    Select event
      Case #PB_Event_CloseWindow
        quit = #True
      Case #PB_Event_Menu
        Select EventMenu()
          Case 1 : SCI_LoadFile(0,OpenFileRequester("SCI Test","*.dba","Basic *.dba,*.bas|*.dba;*.bas|All Files *.*|*.*",0))
          Case 2 : SCI_SaveFile(0,SaveFileRequester("SCI Test","*.dba","Basic *.dba,*.bas|*.dba;*.bas|All Files *.*|*.*",0))
          Case 3 : quit = #True
          Case 4 : DBC_FindText(0,InputRequester("SCI Test","Text to find","msg"))
          Case 5 : DBC_GotoLine(0,Val(InputRequester("SCI Test","Line to go to","1")))
          Case 6 : ToggleCurrentFold(0)
          Case 7
            If TheTip
              RunProgram(TheTip)
              ;msg.s=Space(255)
              ;GetWindowText_(StatusBarID(0),@msg,200)
              ;msg=Trim(msg)
              ;messagerequester("Testing",msg,0)
            EndIf
        EndSelect
    EndSelect
    
  Until quit
EndProcedure
SCI_Test()