rem -- For this macro to work you need at
rem -- least one line of non outline (eg BT)
rem -- text between headings.

rem -- You must enure that there are no
rem -- empty headers.

rem -- You must also ensure that the style ZZ
rem -- is not defined and that the style BT is available.

rem -- 1.1	Replaced ToBack: with ToFront: for performance
rem --			Changed dialog to use dText
rem --			Added autoformat feature
rem --			Added automatic numbering
rem --			Remember format options across invocations
rem --
rem -- 1.0	First cut

PROC macro:

	global firstpg%
	global tcstyle%
	global tcnum%
	global otlevel%
	
	global curlvl%
	global lastlvl%
	global level%(9)

	local x%


	UseApp: ("Active")

	loadvars:

	if dodlg%: > 0

		minit:
		
		if tcstyle%=2 or tcnum%=2
			x%=1
			while x%<=otlevel%
				mklevel:(x%)
				x%=x%+1
			endwh
		else
			otlevel:(otlevel%)
		endif
			
		x%=1
		while mkpage%:(x%)<>0
			x%=x%+1
		endwh
			
		buildtoc:

		mdeinit:
		SendKey: (260, 12, 1)	rem goto top
		savevars:

	endif

ENDP

PROC modeot:
	rem -- switch to outline mode
	
	rem switch to normal mode if in outline
	SendKey: (27, 0, 1)
	SendKey: (623, 10, 1)
ENDP

PROC modenm:
	rem set -- normal mode
	SendKey: (27, 0, 1)
ENDP

PROC minit:

	rem -- macro initialisation

	rem setup bring server
	BringSvr:
	
	modenm:

	rem make sure we have a blank line at top
	SendKey: (260, 12, 1)	rem goto top
	Enter:
	Up:
	SendKey: (2, 4, 1)	rem ctrl b
	SendKey: (20, 4, 1)	rem ctrl t
	rem separate toc with page break
	SendKey: (627, 10, 1)
	Up:
	Up:
	Right:
	Enter:
	
	rem set up internal marker
	SendKey: (261, 12, 1)	rem goto end of document
	SendText: ("x")
	Enter:
	SendText: ("ÏEÏ")
	
	rem set up our own outline level 1
	rem which starts a new page
	SendKey: (616, 10, 1)
	SendKey: (612, 8, 1)
	Up:
	SendText: ("1")
	Up:
	Tab:
	Up:
	Left:
	Enter:
	Enter:
	SendText: ("ZZZZ Temp")
	Down:
	SendText: ("ZZ")
	Enter:
	
ENDP

PROC mdeinit:

	rem -- deinitialise macro
	
	rem delete internal marker
	modenm:
	SendKey: (261, 12, 1)
	SendKey: (262, 10, 1)
	Delete:
	Delete:
	Delete:
	
	rem delete our outline style
	SendKey: (616, 10, 1)
	SendKey: (632, 8, 1)
	Left:
	Delete:
	SendKey: (27, 0, 1)
	
ENDP


PROC mkpage%:(x%)

	local x$(255)
	rem -- mark level
	
	jpage:(x%)
	modeot:

	SendKey: (262, 8, 1)
	SendKey: (right%, shift%, 4)
	x$=GetText$:
	SendKey: (left%, shift%, 4)
	
	if Left$(x$, 3)="ÏEÏ"
		rem finished
		return 0
	endif

	if Left$(x$, 1)="Ï"
		rem last page had no headers
		SendKey: (right%, shift%, 4)		
	endif
	
	x$=Gen$(x%, 2)
	if Len(x$)<2
		x$="0"+x$
	endif
	SendText: ("Ï"+x$+"Ï")
	return 1
ENDP

PROC bringsvr:
	rem SETUP BRING SERVER
	SendKey: (right%, shift%, 1)
	if CurrPid%: <> SrvPid%:
		ToFront:
		ToFront:
	endif
	SendKey: (left%, shift%, 1)
ENDP


PROC dodlg%:

	local x%, y%
	local x$(25)
	local tcstyle$(2, 25)
	local tcnum$(2, 3)
	
	tcstyle$(1)="Unformatted table"
	tcstyle$(2)="AutoFormat table"
	
	tcnum$(1)="No"
	tcnum$(2)="Yes"
	
	do
		dInit: ("Table of contents")
		dText: ("Generate table", "", $600)
		dText: ("First page number", Gen$(firstpg%, 2), $400)
		dText: ("Outline level", Gen$(otlevel%, 2), $400)
		dText: ("Number headings", tcnum$(tcnum%), $400)
		dText: ("Generate AutoFormat styles", "", $400)
		dText: (tcstyle$(tcstyle%), "", $400)

		x%=Dialog:
		
		if x%=3
			x$=Gen$(firstpg%, 2)
			dInit: ("Table of contents")
			dEdit: (addr(x$), "First page number", 3)
			if Dialog:>0 and Val(x$)>0
				firstpg%=Val(x$)
			endif
		endif
		
		if x%=4
			otlevel%=getlvl%:("Outline level")
		endif
		
		if x%=5
			if tcnum%=1
				tcnum%=2
			else
				tcnum%=1
			endif
		endif
		
		if x%=6
			crttati:
			tcstyle%=2
		endif
		
		if x%=7
			if tcstyle%=1
				tcstyle%=2
			else
				tcstyle%=1
			endif
		endif

	until x%=0 or x%=2
	return x%
	
ENDP


PROC jpage:(x%)
	rem go to page number
	SendKey: (618, 8, 1)
	SendText: (Gen$(x%, 2))
	Enter:
ENDP

PROC buildtoc:
	
	rem -- assumes already in outline mode
	
	local lines%, curline%, page%, x%
	local x$(255)
	
	lines%=gtoclns%:
	curline%=1
		
	while curline%<=lines%
		modeot:
		SendKey: (260, 12, 1)
		
		if curline%>1
			SendKey: (down%, 0, curline%-1)
		endif
		
		rem check for page number
		SendKey: (262, 8, 1)
		SendKey: (right%, shift%, 4)
		x$=GetText$:
		
		if Left$(x$, 1)="Ï"
			page%=Val(Mid$(x$, 2, 2))
			Delete:
		else
			SendKey: (left%, shift%, 4)
		endif
		
		rem check for level
		if tcstyle%=2 or tcnum%=2
			SendKey: (right%, shift%, 3)
			x$=GetText$:
		
			curlvl%=Val(Mid$(x$, 2, 1))
			Delete:
		endif
		
		rem copy header to top of document
		SendKey: (263, 10, 1)	rem select
		SendKey: (611, 8, 1)	rem copy
		SendKey: (260, 12, 1)	rem goto top
		
		x%=1
		while (x%<curline%)
			Down:
			x%=x%+1
		endwh
		
		Enter:
		Up:
		Psion: (%i)					rem insert
		SendKey: (2, 4, 1)	rem ctrl b
		SendKey: (20, 4, 1)	rem ctrl t
		
		rem autoformat
		if tcstyle%=2
			SendKey: (20, 4, 1)	rem ctrl t
			SendKey: (curlvl%, 4, 1) rem toc style
		endif
		Tab:
		SendText: (Gen$(page%+firstpg%+1%, 2))
		
		if tcnum%=2
			Home:
			number:(1, otlevel%)
		endif
		
		curline%=curline%+1
	endwh
		
ENDP

PROC gtoclns%:

	local lines%
	local x$(255)
	
	lines%=0

	SendKey: (260, 12, 1)

	do
		SendKey: (262, 8, 1)
		SendKey: (right%, shift%, 4)
		x$=GetText$:
		SendKey: (left%, shift%, 4)
		Down:
		
		if Left$(x$, 3)<>"ÏEÏ"
			lines%=lines%+1
		endif
	until Left$(x$, 3)="ÏEÏ"

	return lines%
ENDP

PROC crttati:

	rem create TA..TI styles
	
	local x%
	
	x%=%A
	
	rem insert blank line at end for creating styles
	SendKey: (pgdn%, ctrl%, 1)
	Enter:
	SendKey: (2, ctrl%, 1)	rem ctrl b
	SendKey: (20, ctrl%, 1)	rem ctrl t
	
	while (x%<%I)
		Psion:(%H)	rem invoke style housekeeping
		Psion:(%d)	rem define new style
		
		if x%=%A
			Tab:			rem set bold font for top level toc entry
			nDown:(3)
			Right:
			Enter:
		endif

		if x%=%B
			Tab:			rem set bold font for top level toc entry
			nDown:(3)
			Left:
			Enter:
		endif
		
		Down:				rem set line indents
		Tab:
		nDown:(2)
		SendText: (Fix$(0.25*(x%-%A), 2, 4))
		Enter:
		
		Down:				rem delete all tabs
		Tab:
		Space:
		
		Down:				rem page numbers appear right justified at 5.5"
		SendText:	("5.5")
		Down:
		Right:
		Enter:
		
		Enter:			rem Enter style name + code
		SendText: ("TOC level "+Gen$(x%+1-%A, 1))
		Down:
		SendKey: (%T, 0, 1)
		SendKey: (x%, 0, 1)

		Enter:			rem Enter style
		SendKey: (27, 0, 1)	rem clear dialog if style already exists
		
		x%=x%+1
	endwh
	
	rem Delete blank line at bottom
	SendKey: (2, ctrl%, 1)	rem ctrl b
	SendKey: (20, ctrl%, 1)	rem ctrl t
	Delete:
	
ENDP

PROC mklevel:(x%)

	local x$(255)
	rem -- mark level
	
	rem go home
	SendKey: (260, 12, 1)
	
	otlevel:(x%)
	modeot:
	SendKey: (262, 8, 1)
	SendKey: (right%, shift%, 3)
	x$=GetText$:
	SendKey: (left%, shift%, 3)
	
	while Left$(x$, 3) <> "ÏEÏ"
		if Left$(x$, 1) <> "ñ"
			SendText: ("ñ"+Gen$(x%, 1)+"ñ")
			modeot:
		endif
		Down:
		SendKey: (262, 8, 1)
		SendKey: (right%, shift%, 3)
		x$=GetText$:
		SendKey: (left%, shift%, 3)
	endwh
	
ENDP

PROC getlvl%:(prompt$)

	local x%
	
	x%=1
	
	dInit:("")
	while x%<9
		dText:(prompt$, Gen$(x%, 1), $400)
		x%=x%+1
	endwh
	
	x%=Dialog:
	
	if x%=0
		x%=1
	endif
	
	return x%
ENDP

PROC otlevel:(x%)

	rem -- set outline level
	SendKey: (616, 8, 1)
	SendKey: (48+x%, 0, 1)
	Enter:
ENDP 

PROC number:(start%, end%)

	local x%
	local number$(30)

	if curlvl%>lastlvl%
		if lastlvl%<start%
			lastlvl%=start%+1
			level%(start%)=level%(start%)+1
		else
			lastlvl%=lastlvl%+1
		endif

		rem - reset all levels from lastlevel up to current level
		while lastlvl%<=curlvl%
			level%(lastlvl%)=1
			lastlvl%=lastlvl%+1
		endwh
		lastlvl%=curlvl%
	elseif curlvl%=lastlvl%
		level%(lastlvl%)=level%(lastlvl%)+1
	elseif curlvl%<lastlvl%
		level%(curlvl%)=level%(curlvl%)+1
		lastlvl%=curlvl%
	endif
		
	if curlvl%>=start% and curlvl%<=end%
		rem build up number string
		number$=""

		x%=start%
		while x%<curlvl%
			number$=number$+gen$(level%(x%), 2)+"."
			x%=x%+1
		endwh

		number$=number$+gen$(level%(curlvl%), 2)+" "
		SendText: (number$)
	endif
ENDP 

PROC savevars:

	local x$(2)
	
	x$=Gen$(firstpg%, 2)
	if Len(x$)<2
		x$="0"+x$
	endif
	
	var%(3)=Val(Gen$(tcnum%,1)+Gen$(tcstyle%,1)+Gen$(otlevel%, 1)+x$)
ENDP 

PROC loadvars:

	local var$(5)

	if var%(3)=0
		firstpg%=1
		tcstyle%=1
		tcnum%=2
		otlevel%=3
		lastlvl%=1
	else
		var$=Gen$(var%(3), 5)
		firstpg%=Val(Right$(var$, 2))
		otlevel%=Val(Mid$(var$, 3, 1))
		tcstyle%=Val(Mid$(var$, 2, 1))
		tcnum%=Val(Mid$(var$, 1, 1))
	endif
ENDP