'****************************************
'Collector - collects footnotes from the files in a Help project.
'****************************************
Declare Sub Yield Lib "Kernel"		'For yield command
Sub Main
Dim ErrorLev, ffPath$, ffName$, UseRTF
ErrorLev = 0
GetProjDir ffPath$, ffName$, ErrorLev	'What you'd think
If ErrorLev <> 0 Then Goto Quit
GetRunMode RunMode, ErrorLev		'Run quick, or allow access to other programs
If ErrorLev <> 0 Then Goto Quit
DOCorRTF UseRTF, ErrorLev		'Use .DOC files or .RTF files
If ErrorLev <> 0 Then Goto Quit

JustDir ffPath$				'Separate the path from the file name...
ChDir ffPath$				'...and change to that directory
JustName ffName$			'Separate the file name from the path
ToolsOptionsView .Hidden = 0
CollectFootnotes ffName$, RunMode, UseRTF	'Main routine
If  AppMinimize() Then AppRestore
MsgBox "All the footnotes have been collected.", "Footnote Collector Macro", 64	'We're done!
Quit:
If  AppMinimize() Then AppRestore
End Sub

'****************************************
Sub GetProjDir(ffPath$, ffName$, ErrorLev)
Dim NumFndFiles, i, n
	FileFind .Location = "All local drives", .Name = "*.hpj", .Options = 0, .SortBy = 4
	NumFndFiles = CountFoundFiles()
	Dim HPJ$(NumFndFiles)
	For i = 1 To NumFndFiles
		HPJ$(i - 1) = FoundFileName$(i)
	Next

	Begin Dialog UserDialog 558, 142, "Select a project file"
		ListBox 14, 43, 414, 84, HPJ$(), .ListBox1
		OKButton 448, 43, 88, 21
		CancelButton 448, 67, 88, 21
		Text 14, 9, 475, 13, "Select the Windows Help project from which to collect"
		Text 14, 22, 187, 13, "the footnote information."
	End Dialog
	Dim HPJ As UserDialog
	n = Dialog(HPJ)		'Figure out how to do On Error here
	If n = 0 Then ErrorLev = 1
	ffName$ = HPJ$(HPJ.ListBox1)
	ffPath$ = ffName$
End Sub

'****************************************
Sub GetRunMode(Fast, ErrorLev)
Dim n
	Begin Dialog UserDialog 484, 156, "Select Run Mode"
		OKButton 379, 6, 88, 21
		CancelButton 379, 30, 88, 21
		OptionGroup  .Opt1
			OptionButton 10, 6, 320, 16, "FAST MODE - Runs quick as possible,"
			OptionButton 10, 55, 344, 16, "RELAXED MODE - Slower, but allows you"
		Text 33, 21, 256, 13, "but tends to be a hog with system"
		Text 33, 34, 80, 13, "resources."
		Text 33, 70, 311, 13, "access to other programs, such as email,"
		Text 33, 83, 215, 13, "games to pass the time, etc."
		Text 33, 108, 380, 13, "Both modes will reduce the application to an icon."
		Text 33, 121, 343, 13, "Without having to update the screen, macros"
		Text 33, 134, 191, 13, "typically run much faster."
	End Dialog
	Dim dlg As UserDialog
	n = Dialog(dlg)
	If n = 0 Then ErrorLev = 1	'If they click Cancel, let the main routine know
	If dlg.Opt1 = 0 Then
		Fast = 1	'run without pauses
	Else
		Fast = 0	'run in minimized mode
	EndIf
End Sub

'****************************************
Sub DOCorRTF(UseRTF, ErrorLev)
Dim n
	Begin Dialog UserDialog 460, 96, "Use which file type?"
		Text 10, 6, 325, 13, "If available, this macro will run much faster"
		Text 10, 19, 312, 13, "on .DOC files than on .RTF files.  Do you"
		Text 10, 33, 209, 13, "want to use the .DOC files?"
		OptionGroup  .Opt1
			OptionButton 42, 50, 137, 16, "Use .RTF files"
			OptionButton 42, 66, 140, 16, "Use .DOC files"
		OKButton 362, 11, 88, 21
		CancelButton 362, 35, 88, 21
	End Dialog
	Dim dlg As UserDialog
	n = Dialog(dlg)
	If n = 0 Then ErrorLev = 1	'If they click Cancel, let the main routine know
	If dlg.Opt1 = 0 Then UseRTF = 1	'They chose to use .RTF files (default)
End Sub


'****************************************
Sub JustDir(t$)		'Separate the path from the file name
Dim i
	i = Len(t$)
	While Mid$(t$, i, 1) <> "\"
		i = i - 1
	Wend
	i = i - 1
	t$ = Left$(t$, i)
End Sub

'****************************************
Sub JustName(t$)		'Separate the file name from the path
Dim i
	i = Len(t$)
	While Mid$(t$, i, 1) <> "\"
		i = i - 1
	Wend
	i = Len(t$) - i
	t$ = Right$(t$, i)
End Sub

'****************************************
Sub FindFilesSection(ffName$)
'Locates the [Files] section of a .HPJ file
Dim done, r$
Open ffName$ For Input As #1	'Open the .HPJ file
done = 0
On Error Goto Oops
While done = 0
	Read #1, r$		'Get a line from the file
	r$ = Left$(r$, 7)
	If(r$ = "[FILES]" Or r$ = "[files]" Or r$ = "[Files]") Then
		done = 1
	EndIf
Oops:
Wend
End Sub

'****************************************
Sub CleanupName(rtf$)	'Gets rid of any comments after the filename
Dim n1, n2
	n1 = InStr(rtf$, ".RTF")
	n2 = InStr(rtf$, ".rtf")
	If n1 <> 0 Then rtf$ = Left$(rtf$, n1 + 3)
	If n2 <> 0 Then rtf$ = Left$(rtf$, n2 + 3)
End Sub

'****************************************
Sub CollectFootnotes(ffName$, RunMode, UseRTF)
'This is just Collector as a subroutine, with the RunMode option added.
'We've already changed directories, and have the filename, so first we need to
'find out how many files there are.  Then dim an array and fill it up.  Then
'Collector can handle the rest, as is.

Dim HelpTitle$, KeyTitle$, Browse$, KeyWord$, HelpID$, Comments$
Dim BuildTag$, EntryMacro$, r$, RTFCount, ffAppend, done, n1, n2, i

'Find out if we should append to TRACKER.CSV or create a new one
r$ = Files$("tracker.csv")
If r$ <> "" Then AppendCSV ffAppend

'This section counts the files
FindFilesSection ffName$		'Open the .HPJ file and locate the [Files] section
done = 0
RTFCount = 0
While done = 0
	Input #1, r$
	If Eof(1) Then done = 1
	If Left$(r$, 1) <> ";" Then
		n1 = InStr(r$, ".RTF")
		n2 = InStr(r$, ".rtf")
		If(n1 > 0 Or n2 > 0) Then
			RTFCount = RTFCount + 1
		Else
			done = 1
		EndIf
	EndIf
Wend
Close #1		'Close the .HPJ file so we can open it again

'Now we open the .HPJ file and read the file names into an array
FindFilesSection	ffName$	'Reopen the file and find the [FILES] section again
Dim RTF$(RTFCount)
For i = 1 To RTFCount
	Input #1, r$
	If Left$(r$, 1) <> ";" Then
		CleanupName r$
		RTF$(i) = r$
	Else
		i = i - 1
	EndIf
Next				'Now we have the array of names and can read them.
Close #1

If UseRTF = 0 Then		'If user wants to read .DOC files
	For i = 1 To RTFCount
		RTF$(i) = Left$(RTF$(i), Len(RTF$(i)) - 3)
		RTF$(i) = RTF$(i) + "doc"
	Next
EndIf

'Open a text file for writing, and overwrite if already existing, then write the column titles to it.

If ffAppend = 1 Then
	Open "TRACKER.CSV" For Append As #1
Else
	Open "TRACKER.CSV" For Output As #1
EndIf

If ffAppend = 0 Then
	Write #1, "File Name", \
		"Topic Title", \
		"Keyword Search Title", \
		"Context ID (Help Token)", \
		"Browse Seq.", \
		"Key Words", \
		"Comments", \
		"Build Tags", \
		"Entry Macro"
EndIf

REM	WOPR.Echo 0		'Turn off screen updates

AppMinimize			'Turn off screen updates by minimizing
'Start opening TOC files and run the main routines.
For i = 1 To RTFCount
	DisableAutoMacros 1		'Don't let Auto... macros mess us up
	FileOpen .Name = RTF$(i), .ReadOnly = 0
	If Not DocMaximize() Then DocMaximize

	'Process the help topics and get the footnotes
	GetFootNotes RTF$(i), KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, \
	BuildTag$, EntryMacro$


	SetDirty 0		'Mark file as unchanged
	FileClose     		'Close file without saving it.
Next				'Next file

'Whatever the outcome, close up shop and put things back the way they were.
TheEnd:				'On Error, close the file and end the macro.
Close #1				'Close TRACKER.CSV
DisableAutoMacros 0		'Reenable AutoMacros
REM	WOPR.Echo 1		'Echo back on
End Sub	

'*************************************************
'Processes all help topics in the document
Sub GetFootNotes(FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, \
	BuildTag$, EntryMacro$)

Print "Working on " + FileNm$	'Let user know what's up....

'Do the very first topic in the file, which is assumed to be the first thing in the file.
StartOfDocument
'Initialize variables for each heading
	HelpTitle$ = "-"
	KeyTitle$ = "-"
	Browse$   = "-"
	KeyWord$  = "-"
	HelpID$   = "-"
	Comments$  = "-"
	BuildTag$ = "-"
	EntryMacro$ = "-"
GetFeet FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$

'Get text of current topic title
ParaDown 1, 1 : CharLeft 1, 1 : HelpTitle$ = Selection$()

'Write out the global footnote info
Write #1, FileNm$, HelpTitle$, KeyTitle$, HelpID$, \
Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$

'Search for page breaks, which indicate a new topic
'*********
EditFindClearFormatting
EditFind .Find = "^d", .Direction = 2, .Format = 0
While EditFindFound()
	If RunMode = 0 Then Yield	'Let the system have some time
	HelpTitle$ = "-"		'Initialize variables for each heading
	HelpID$   = "-"
	KeyTitle$ = "-"
	Browse$   = "-"
	KeyWord$  = "-"
	Comments$  = "-"
	CharRight 1		'First character after page break

	'Do the footnotes
	GetFeet FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, \
		EntryMacro$

	'Get text of current topic title
	ParaDown 1, 1
	CharLeft 1, 1 : HelpTitle$ = Selection$()
	If Mid$(HelpTitle$, 1, 1) = Chr$(13) Then HelpTitle$ = "--"
	If Len(HelpTitle$) > 90 Then HelpTitle$ = Left$(HelpTitle$, 40)

'ShowVars
	'Write out the global footnote info
	Write #1, FileNm$, HelpTitle$, KeyTitle$, HelpID$, \
	Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$

	EditFind .Find = "^d", .Direction = 2, .Format = 0	'Search again
Wend
End Sub

'****************************
'Extract footnote strings.  Each loop extracts one footnote string.
'Loop until text is encountered that is not a footnote, or until a
'footnote we don't recognize is encountered.
Sub GetFeet(FileNm$, KeyTitle$, HelpID$, Browse$, KeyWord$, Comments$, BuildTag$, EntryMacro$)
Dim chFootnote$
FootnoteLoop:
	'Assert: footnotes not visible, focus in main pane
	'Skip whitespace between footnotes
	While Selection$() = " "
		CharRight
	Wend

	' Check for non-footnote character
	CharRight 1, 1
	chFootnote$ = Selection$()

	'NOTE: Technically, footnotes don't have to be superscript, and the compiler
	'would accept them if they weren't.  However, this test makes the following loop
	'safer, and Winword will never create footnotes that aren't superscripted.

REM	If SuperScript() <> 1 Then Goto endfootnoteloop	'This is one way to check for footnotes
	'Move to the footnote text for this footnote, and verify that the footnote character
	'here matches the one  in the main text.
	ViewFootnotes 1
	If Selection$() <> chFootnote$ Then	'This is the other way to check for footnotes
		ViewFootnotes 0
		Goto endfootnoteloop
	End If
	'Extract the footnote text
	CharRight
	While Selection$() = " "
		CharRight
	Wend
	'Select all the text for this footnote.  Since none of the footnotes
	'can legally contain a paragraph marker, and every footnote ends
	'in one, search for that.
	ExtendSelection	'extend selection mode
	EditFind .Find = "^p", .Direction = 2, .Format = 0
	CharLeft 1, 1
	Cancel
	szFootnote$ = Selection$()
	ViewFootnotes 0
REM
	FormatCharacter .Position = "3 pt", .Spacing = "0 pt"
REM

	'Assign footnote text to appropriate field in Topic dialog
	Select Case Asc(chFootnote$)
	Case Asc("$")
		KeyTitle$ = szFootnote$

	Case Asc("#")
		HelpID$ = szFootnote$

	Case Asc("K"), Asc("k")
		Keyword$ = szFootnote$
	Case Asc("+")
		Browse$ = szFootnote$
	Case Asc("*")
		BuildTag$ = szFootnote$
	Case Asc("!")					
		EntryMacro$ = szFootnote$	
	Case Asc("@")
		Comments$ = szFootnote$
	Case Else
		fBreakOut = - 1		'illegal to jump out of a Select
	End Select
	If fBreakOut Then Goto endfootnoteloop

	'Deselect footnote character, and repeat loop
	CharRight
	Goto footnoteloop

endfootnoteloop:
	'Assert: footnotes not visible
	CharLeft	' Deselect non-footnote character
End Sub

'****************************
'Find out whether to append or overwrite an existing tracker file
Sub AppendCSV(ffAppend)
Dim n, Loop
DialogLoop:
Begin Dialog UserDialog 340, 92, "Append or Overwrite?"
	Text 26, 6, 292, 13, "The file TRACKER.CSV already exists."
	Text 26, 20, 273, 13, "Do you want to overwrite the file or "
	Text 26, 34, 180, 13, "add on to the end of it?"
	PushButton 10, 60, 88, 21, "&Overwrite"
	PushButton 114, 60, 88, 21, "&Append"
	PushButton 218, 60, 88, 21, "&Help"
End Dialog
Redim dlg As UserDialog
Loop = 0 : n = Dialog(dlg)
Select Case n
	Case 1	'Overwrite - the default
		ffAppend = 0	'don't append
	Case 2	'Append
		ffAppend = 1	'we should append to the file
	Case 3	'Help - provide an explanation
		Redim inst$(38)
		inst$(0) = "If Collector runs without problem on your files,"
		inst$(1) = "you can ignore these instructions."
		inst$(2) = ""
		inst$(3) = "Because of a memory problem in WinWord, it can"
		inst$(4) = "occasionally run out of memory when you least"
		inst$(5) = "expect it.  If you have a Help project of more"
		inst$(6) = "than 16 to 18 files, or if your Help system uses a"
		inst$(7) = "lot of links, then it's likely you'll run out of"
		inst$(8) = "memory before the macro finishes."
		inst$(9)  = ""
		inst$(10) = "Fortunately, I've figured out a workaround:"
		inst$(11) = "1) Run the macro until it runs out of memory."
		inst$(12) = "2) Exit Windows entirely.  (If you're superstitious"
		inst$(13) = "    you might want to reboot at this time.)"
		inst$(14) = "3) Use a text editor or word processor (you"    
		inst$(15) = "    could even use Word) to remove all the lines"
		inst$(16) = "    from TRACKER.CSV in which the first entry is"
		inst$(17) = "    the name of the file the macro was working on"
		inst$(18) = "    when it crapped out.  For example, if the"
		inst$(19) = "    macro quit while working on CHAP14.DOC,"
		inst$(20) = "    open the file in your text editor and find the"
		inst$(21) = "    first line which begins with " + Chr$(34) + "CHAP14.DOC" + \
				Chr$(34) + "."
		inst$(22) = "    Delete everything after that."
		inst$(23) = "4) Save TRACKER.CSV (as Text Only if you use"
		inst$(24) = "    Word or another word processor)."
		inst$(25) = "5) Copy your project file to another name.  For"
		inst$(26) = "    example, copy MYPROJ.HPJ to TEMP.HPJ."
		inst$(27) = "6) Edit the copy of your project file and remove"
		inst$(28) = "    all the names in the [Files] section BEFORE"
		inst$(29) = "    the file the macro crapped out on.  In my"
		inst$(30) = "    example, I'd remove the names CHAP1.DOC"
		inst$(31) = "    through CHAP13.DOC, leaving CHAP14.DOC"
		inst$(32) = "    through, say, CHAP20.DOC."
		inst$(33) = "7) Save the copy of the project file."
		inst$(34) = "8) Restart WinWord and restart the macro.  This"
		inst$(35) = "    time, choose the copy of the project file."
		inst$(36) = "9) When prompted, choose Append instead of"
		inst$(37) = "    Overwrite."

		Begin Dialog UserDialog 536, 284, "Overwrite vs. Append"
			ListBox 15, 10, 405, 273, Inst$(), .ListBox1
			PushButton 432, 109, 88, 21, "Done"
		End Dialog
		Redim InstText As UserDialog
		n = Dialog(InstText)
		Loop = 1
End Select
If Loop = 1 Then Goto DialogLoop
End Sub