VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "InfoDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public doc_ As Word.Document
Public gid_ As Long
Public linkSystem_ As TLinkSystem

Private Sub Class_Initialize()
  gid_ = HT03_INVALID_GID
  linkSystem_ = DEFAULT_LINK_SYSTEM
End Sub

Public Function Init(doc As Word.Document) As Boolean
  Init = False
  
  If doc.Hyperlinks.Count = 0 Then _
    Exit Function
  
  Dim oTitleLink As Word.Hyperlink: Set oTitleLink = doc.Hyperlinks(1)
  Dim oFirstPara As Word.Range: Set oFirstPara = doc.Paragraphs(1).Range
  If oFirstPara.Start <> oTitleLink.Range.Start Then _
    Exit Function
  If VBA.Abs(oFirstPara.End - oTitleLink.Range.End) > 1 Then _
    Exit Function
  
  Dim iLink As ItemHyperlink: Set iLink = ParseHyperlink(oTitleLink)
  Set doc_ = doc
  gid_ = iLink.DocumentID
  linkSystem_ = iLink.LinkSystem
  
  Init = True
End Function

Public Function GetSelection() As Word.Range
  Set GetSelection = doc_.Application.Selection.Range
End Function

Public Function GetLawDescription() As ItemLaw
  Dim sTitle$: sTitle = doc_.Paragraphs(1).Range.Text
  Dim iLaw As ItemLaw: Set iLaw = ParseLawTitle(sTitle)
  If iLaw Is Nothing Then
    Set iLaw = New ItemLaw
    iLaw.title_ = ApplyCommonAbbreviations(SubstituteWhitespace(sTitle))
  End If
  iLaw.gid_ = gid_
  iLaw.fileName_ = doc_.Name
  Set GetLawDescription = iLaw
End Function

Public Function UpdateStyles(sTemplate$)
  Dim sTarget$: sTarget = doc_.FullName
  Dim sStyle As Variant
  For Each sStyle In GetAllLinkStyles()
    Call WordCopyStyle(doc_.Application, sTemplate, sTarget, CStr(sStyle))
  Next sStyle
End Function

Public Function CreateTitleLink()
  Dim iLink As New ItemHyperlink: Call iLink.Init(linkSystem_, gid_)
  Dim rTitle As Word.Range: Set rTitle = doc_.Paragraphs(1).Range
  rTitle.End = rTitle.End - 1
  Call rTitle.Hyperlinks.Add(rTitle, iLink.ToAddress())
End Function

Public Function AddHyperlink(target As Word.Range, iLink As ItemLink, sStyle$) As Boolean
  AddHyperlink = False
  
  If target.End <= target.Start Then _
    Exit Function
  On Error GoTo RETURN_FALSE
  
  Dim newLink As New ItemHyperlink: Call newLink.Init(linkSystem_, iLink.destID_, iLink.destSub_)
  Call target.Hyperlinks.Add(target, newLink.ToAddress())
  target.Style = target.Document.Styles(sStyle)
  If iLink.sourceSub_ <> vbNullString Then
    Dim rBookmark As Word.Range: Set rBookmark = target.Paragraphs(1).Range
    Dim sBookmarkName$: sBookmarkName = iLink.sourceSub_
    If Not rBookmark.Bookmarks.Exists(sBookmarkName) Then
      If doc_.Bookmarks.Exists(sBookmarkName) Then _
        Exit Function
      Call rBookmark.Bookmarks.Add(sBookmarkName, rBookmark)
    End If
  End If
  On Error GoTo 0
  
  AddHyperlink = True
  Exit Function
  
RETURN_FALSE:
End Function

Public Function FormatLink(target As Word.Hyperlink, _
                            nLinkType As TLinkType, nLinkStatus As TLinkStatus, _
                            sSource As TLawStatus, sDestination As TLawStatus)
  Dim sStyle$: sStyle = doc_.Styles(GetLinkStatusStyle(sSource, sDestination, nLinkType))
  With target.Range
    .Style = sStyle
    .Font.StrikeThrough = nLinkStatus = T_LINKS_IGNORE
  End With
End Function

Public Function ApplyLinkStatus(target As Word.Hyperlink, nLinkStatus As TLinkStatus)
  target.Range.Font.StrikeThrough = nLinkStatus = T_LINKS_IGNORE
End Function

Public Function CountLinksBefore(nTarget&) As Long
  Dim aLink As Word.Hyperlink
  For Each aLink In doc_.Hyperlinks
    If aLink.Range.Start >= nTarget Then _
      Exit Function
    If IsHyperlinkValid(aLink) Then _
      CountLinksBefore = CountLinksBefore + 1
  Next aLink
End Function

Public Function CountLinksIn(target As Word.Range) As Long
  Dim docHLink As Word.Hyperlink
  For Each docHLink In target.Hyperlinks
    If IsHyperlinkValid(docHLink) Then _
      CountLinksIn = CountLinksIn + 1
  Next docHLink
End Function

' Requires theDB.Contains(nDestination)
Public Function UpdateLinkTip(target As Word.Hyperlink, nDestination&, theDB As InfoDatabase)
  Const MAX_TIP_LENGTH% = 255
  Dim sTip$: sTip = Left(theDB.Data(nDestination).Title, MAX_TIP_LENGTH)
  If sTip <> vbNullString Then _
    target.ScreenTip = sTip
End Function

Public Function UpdateFormat(theDB As InfoDatabase) As Long
  If Not theDB.HasLinksFor(gid_) Then _
    Call Err.Raise(ERR_LINKS_MISSING)
    
  Dim nUnresolved&: nUnresolved = 0
  Dim sSource As TLawStatus: sSource = theDB.Cache(gid_).status_
  
  Dim itLink As IteratorLinkCached: Set itLink = theDB.LawLinksCached(gid_)
  Dim bNoMoreLinks As Boolean: bNoMoreLinks = False
  Dim docHLink As Word.Hyperlink
  For Each docHLink In doc_.Hyperlinks
    Dim iLink As ItemHyperlink: Set iLink = ParseHyperlink(docHLink)
    If iLink Is Nothing Then _
      GoTo NEXT_LINK
    If bNoMoreLinks Then _
      Call Err.Raise(ERR_SYNC_DB)
    Call iLink.ValidateSync(itLink)
    
    Dim nDestination&: nDestination = itLink.DestinationID
    If nDestination = gid_ And itLink.IsFirst Then _
      GoTo INCREMENT_LINK
    Call FormatLink(docHLink, itLink.LType, itLink.Status, sSource, theDB.GetLawStatus(nDestination))
    If theDB.Contains(nDestination) Then _
      If docHLink.ScreenTip Like "http*" Or docHLink.ScreenTip = vbNullString Then _
        Call UpdateLinkTip(docHLink, nDestination, theDB)
        
    If Not itLink.IsProcessed Then _
      nUnresolved = nUnresolved + 1
INCREMENT_LINK:
    bNoMoreLinks = Not itLink.Increment
NEXT_LINK:
    Call CSE_ProgressBar.IncrementA
  Next docHLink

  If itLink.Increment Then _
    Call Err.Raise(ERR_SYNC_DOC)
    
  UpdateFormat = nUnresolved&
End Function

Public Function UpdateFormatFilter(docsFilter As Scripting.Dictionary, theDB As InfoDatabase)
  Dim sSource As TLawStatus: sSource = theDB.Cache(gid_).status_
  
  Dim itLink As IteratorLinkCached: Set itLink = theDB.LawLinksCached(gid_)
  Dim bNoMoreLinks As Boolean: bNoMoreLinks = False
  Dim docHLink As Word.Hyperlink
  For Each docHLink In doc_.Hyperlinks
    Dim iLink As ItemHyperlink: Set iLink = ParseHyperlink(docHLink)
    If iLink Is Nothing Then _
      GoTo NEXT_LINK
    If bNoMoreLinks Then _
      Exit Function
    Call iLink.ValidateSync(itLink)
    
    Dim nDestination&: nDestination = itLink.DestinationID
    If Not docsFilter.Exists(nDestination) Then _
      Call FormatLink(docHLink, itLink.LType, itLink.Status, sSource, theDB.GetLawStatus(nDestination))
    bNoMoreLinks = Not itLink.Increment
NEXT_LINK:
  Next docHLink
End Function

Public Function FindNextUnresolved(posStart&) As Word.Hyperlink
  If posStart >= doc_.Range.End Then _
    Exit Function
  If posStart < 0 Then _
    posStart = 0
    
  Dim searchArea As Word.Range: Set searchArea = doc_.Range(posStart, doc_.Range.End)
  Set FindNextUnresolved = NextUnresolvedIn(searchArea)
  If Not FindNextUnresolved Is Nothing Then _
    Exit Function
  If posStart <= doc_.Paragraphs(1).Range.End Then _
    Exit Function
  
  Set searchArea = doc_.Range(doc_.Paragraphs(1).Range.End, posStart)
  Set FindNextUnresolved = NextUnresolvedIn(searchArea)
End Function

Public Function IgnoreLawLinks(docsToIgnore As Scripting.Dictionary)
  If docsToIgnore.Count = 0 Then _
    Exit Function
  
  Dim iLink As ItemHyperlink
  Dim docHLink As Word.Hyperlink
  For Each docHLink In doc_.Hyperlinks
    Set iLink = ParseHyperlink(docHLink)
    If Not iLink Is Nothing Then
      If docsToIgnore.Exists(iLink.DocumentID) Then
        Dim bTmp As Boolean: bTmp = docHLink.Range.Font.StrikeThrough
        docHLink.Range.Style = Style4A
        docHLink.Range.Font.StrikeThrough = bTmp
      End If
    End If
  Next docHLink
End Function

Public Function RemoveLinksFrom(target As Word.Range)
  Dim aLink As Word.Hyperlink
  Dim n&: n = 1
  Do While n <= target.Hyperlinks.Count
    Set aLink = target.Hyperlinks.Item(n)
    If IsHyperlinkValid(aLink) Then
      aLink.Range.Style = wdStyleDefaultParagraphFont
      Call aLink.Delete
    Else
      n = n + 1
    End If
  Loop
End Function

Public Function GetParagraphLink(target As Word.Range) As String
  If target.Bookmarks.Count = 0 Then _
    Exit Function
  GetParagraphLink = CStr(gid_) & "#" & target.Bookmarks(1).Name
End Function

' =======
Private Function NextUnresolvedIn(target As Word.Range) As Word.Hyperlink
  Dim hLink As Word.Hyperlink
  For Each hLink In target.Hyperlinks
    If IsUnresolved(hLink) Then
      Set NextUnresolvedIn = hLink
      Exit Function
    End If
  Next hLink
End Function

Private Function IsUnresolved(target As Word.Hyperlink) As Boolean
  IsUnresolved = False
  
  If Not IsHyperlinkValid(target) Then _
    Exit Function
    
  Dim rLink As Word.Range: Set rLink = target.Range.Duplicate
  rLink.Start = rLink.End - 2
  rLink.End = rLink.End - 1
  If rLink.Font.StrikeThrough Then _
    Exit Function
  
  Dim sStyle$: sStyle = rLink.Style
  IsUnresolved = Not IsStyleProcessedWord(sStyle)
End Function

Private Function IsStyleProcessedWord(aName$) As Boolean
  IsStyleProcessedWord = False
  If aName = Style0A Then Exit Function
  If aName = Style10 Then Exit Function
  If aName = Style20 Then Exit Function
  If aName = Style30 Then Exit Function
  IsStyleProcessedWord = True
End Function
