-- Rough sketch - no guarantees (explicit or implied) of how it will behave
-- Ver 003

on run
	tell application "Microsoft Word"
		if (count of documents) < 1 then
			display dialog "Open an outline in Word, and try again"
			return
		end if
	end tell
	
	set lstParas to GetWdParas()
	
	tell application "OmniOutliner Professional"
		set oDoc to make new document
	end tell
	
	Paras2OO(oDoc, lstParas)
end run

on Paras2OO(oDoc, lstParas)
	-- Loop through paras maintaining list of level parents
	set lstLevelParents to {"", "", "", "", "", "", "", "", ""}
	using terms from application "OmniOutliner Professional"
		tell oDoc
			repeat with lstPara in lstParas
				set lngLevel to item 1 of lstPara
				if lngLevel > 0 then
					set oParent to item lngLevel of lstLevelParents
				end if
				
				if lngLevel > 1 then
					set oRow to make new row at end of children of oParent with properties {topic:item 2 of lstPara}
				else
					if lngLevel > 0 then
						set oRow to make new row at end of children with properties {topic:item 2 of lstPara}
					else
						tell oRow
							set note to note & item 2 of lstPara
						end tell
					end if
				end if
				if lngLevel > 0 then
					set item (lngLevel + 1) of lstLevelParents to oRow
				end if
			end repeat
			set expanded of every row to true
			set note expanded of every row to true
		end tell
	end using terms from
end Paras2OO


on GetWdParas()
	tell front document of application "Microsoft Word"
		-- get list of paras and their outline levels
		set lstParas to {}
		
		set oParas to paragraphs
		repeat with oPara in oParas
			-- Get heading level from style name
			set strStyle to name local of style of oPara
			set my text item delimiters to " "
			set lstParts to text items of strStyle
			if length of lstParts > 1 then
				if item 1 of lstParts ≠ "Heading" then
					--  not an outline header
					set strText to (content of text object of oPara)
					set lstParas to lstParas & {{0, strText}}
				else
					set lngLevel to (item 2 of lstParts) as integer
					
					-- Get text without trailing /r
					set strText to (content of text object of oPara)
					set my text item delimiters to ""
					set lngChars to length of strText
					if lngChars > 1 then
						set strText to (characters 1 thru (lngChars - 1) of strText) as string
					end if
					set lstParas to lstParas & {{lngLevel, strText}}
				end if
			else
				-- not an outline header
				set strText to (content of text object of oPara)
				set lstParas to lstParas & {{0, strText}}
			end if
		end repeat
	end tell
	
	-- Ensure that highest level paras are level 1
	set lngMin to 9
	repeat with lstPara in lstParas
		set lngLevel to item 1 of lstPara
		if lngLevel > 0 then
			if (lngLevel < lngMin) then
				set lngMin to lngLevel
			end if
		end if
	end repeat
	
	if lngMin > 1 then
		set lngDelta to lngMin - 1
		repeat with lstPara in lstParas
			set item 1 of lstPara to (item 1 of lstPara) - lngDelta
		end repeat
	end if
	
	--Attend to over-indentations in Word by inserting empty bridging paras at intermediate levels
	set lngPrevLevel to 0
	set lstBridge to {}
	set lngParas to length of lstParas
	set lstAllParas to {}
	repeat with iPara from 1 to lngParas
		set lstPara to item iPara of lstParas
		set lngLevel to item 1 of lstPara
		if lngLevel > 0 then
			if lngLevel > lngPrevLevel then
				set lngDelta to lngLevel - lngPrevLevel
				if lngDelta > 1 then
					repeat with iLevel from (lngPrevLevel + 1) to (lngLevel - 1)
						set lstBridge to lstBridge & {{iLevel, ""}}
					end repeat
					set lstAllParas to lstAllParas & lstBridge & {lstPara}
					set lstBridge to {}
				else
					set lstAllParas to lstAllParas & {lstPara}
				end if
			else
				set lstAllParas to lstAllParas & {lstPara}
			end if
			set lngPrevLevel to lngLevel
		else -- Level = 0
			if lngPrevLevel > 0 then
				set lstAllParas to lstAllParas & {lstPara}
			else -- text para has no preceding header para
				set lstAllParas to lstAllParas & {{1, ""}} & {lstPara}
				set lngPrevLevel to 1
			end if
		end if
	end repeat
	return lstAllParas
end GetWdParas