#--------------------------------------------------
#
# Highlights
#   could have other annotation types, like in situ text,
#   but not worth it.  Put this effort into Multivalent
#
#--------------------------------------------------

# get old highlights and yview, if any

# highlighting commands: update (menu), get (all from database)

proc manHighlightsSetCmd {{incmd add}} {
	global manx curwin bmb
	set w $curwin; # or, upvar #0 curwin w
	set wh $w.high
	set txt "Hi"; if {$incmd=="add"} {set txt "+"} elseif {$incmd=="remove"} {set txt "-"}
	set cmd "add"; if {$incmd=="remove"} {set cmd "remove"}
	$wh configure -text $txt; set bmb($wh) "manHighlights $w $cmd"
}

proc manHighlights {w {cmd update} {auto 0}} {
	global high man manx mani stat

	set t $w.show
	set status ""
	set res ""

	# get/save tags
	set f $manx(manfull$w)
#	if [string match <* $f] {set f [string range $f 1 end]}
	# canonical file name
	if ![catch {set sf [file readlink $f]}] {
		if [string match /* $sf] {
			set f $sf
		} else {
			set f [file dirname $f]
			set strip 1
			while {$strip} {
				switch -glob $f {
					../* {set f [file dirname $f]; set sf [string range $sf 3 end]}
					./* {set sf [string range $sf 2 end]}
					default {set strip 0}
				}
			}
			append f /$sf
		}
	}
	set normalf [zapZ [bolg $f ~]]

	set var high($normalf)

	# try to recover if page moved
	if {$normalf!="" && ![info exists $var]} {
		set movelist {}
		set tail [file tail $normalf]
		foreach hi [array names high] {
			if {$tail==[file tail $hi]} {lappend movelist $hi}
		}
		foreach hi $movelist {
			if {[lsearch $manx(highdontask) $hi]!=-1} continue
			if {[catch {glob $hi$manx(zglob)}]} {
				if {[tk_messageBox -title "Moved Highlight?" -message "It appears that the highlighted page formerly at\n   $hi\nhas moved to\n   $normalf\nMove highlights too?" -icon question -type okcancel]=="ok"} {
					set $var $high($hi); unset high($hi)
					incr stat(high-carry)
				} else {lappend manx(highdontask) $hi}
				break
			}
		}
	}


	if {$cmd=="add" || $cmd=="remove"} {
		if {![llength [$t tag nextrange sel 1.0]]} {
			set errmsg "Select a range of "
			if {$cmd=="add"} {append errmsg "characters to highlight"} {append errmsg "highlighted characters to unhighlight"}

			manWinstderr $w $errmsg
			return
		}
		$t tag $cmd highlight sel.first sel.last
		if {$cmd=="add"} {incr stat(page-highlight-add)} {incr stat(page-highlight-sub)}
		set mani(high,form) {}
		selection clear $t
		set cmd "update"
	}
# define highlights in presence of diffd a nonproblem:
#    not going to be switching between seeing and not seeing all the time,
#    and in the absence of switching, *want* default behavior!
#    when do switch or update page (an infrequent happening), natural robustness carries the day
# elseif {$cmd=="save"} {
#		foreach {s e} [lreverse [$t tag ranges diffd] 2] {$t delete $s $e}
#		set cmd "update"
#	}


	set tags ""
	if {$cmd=="update"} {
		# new style annotations store date (latest) annotation made
		set tags [clock seconds]
		# save some context with tag in hopes of reattaching if the man page changes 
		# (or just reinstalled)
		foreach {first last} [$t tag ranges highlight] {
			eval lappend tags [manHighCompose $t $first $last]
		}

		# clear volume list because updated time of last highlight
		set mani(high,form) {}
		DEBUG {puts "updating highlights to $tags"}
		if {[llength $tags]>1} {set $var $tags} else {catch {unset $var}}
		set status "updated"

	} elseif {[info exists $var]} {
		set tags [set $var]

		if {[llength [lsecond $tags]]>1} {
			set losertxt ""; set dicey 0
			set res "new style"

			# new style highlights -- reattach given initial position and context; date irrelevant
			set newtags [lfirst $tags]; # retain creation date
			foreach {ftuple ltuple} [lrange $tags 1 end] {
				# abuse foreach.  more clear if had "set <var-list> <val-list>"
				foreach {first firsttxt predelta fhooklen} $ftuple break
				foreach {ldelta lasttxt postdelta lhooklen} $ltuple break

				set new [manHighlightAttach $t  $first $firsttxt $predelta $fhooklen   $ldelta $lasttxt $postdelta $lhooklen]
				foreach {status firstnew ldeltanew} $new break
				if {$status=="LOSE"} {
					incr stat(high-lose)
					append losertxt "[string range $firsttxt 0 [expr $predelta-1]] / [string range $firsttxt $predelta end] ($first)   ...   [string range $lasttxt 0 [expr [string length $lasttxt]-$postdelta]] / [string range $lasttxt [expr [string length $lasttxt]-$postdelta+1] end] (+$ldelta)\n"
					append res ", lost one"
				} elseif {$firstnew!=$first || $ldeltanew!=$ldelta} {
					# had to move one, save repositioned information
					incr stat(high-move)
					eval lappend newtags [manHighCompose $t $firstnew "$firstnew+${ldeltanew}c"]
					# dicey move
					if {$status=="DICEY"} { set dicey 1; append res ", dicey move" }
				} else {
					incr stat(high-exact)
					# old info is still good
					lappend newtags $ftuple $ltuple
					append res ", exact"
				}
			}

			set warningtxt ""

			# report losers at bottom
			if {$losertxt!=""} {
				manTextPlug $t end "\n\n\nCouldn't attach these highlights:\n" b $losertxt {} "\n"
				append warningtxt "Some highlights could not be repositioned.  See the bottom of the page for a list.  They will be forgotten unless they are reapplied manually now.   "
			}
			if {$dicey} {
				append warningtxt "Some highlights have moved considerably and may not have been repositioned correctly.  You may want to verify them now.   "
			}
			if {$warningtxt!="" && !$auto} {
				tk_messageBox -title "Warning" -message $warningtxt -icon warning -type ok
			}

			# update persistent info
			set $var $newtags
			set tags $newtags

		} else {
			# old style highlights -- up to date or die
			set res "old style"
			if {![file isfile $f] || [file mtime $f]<=[lfirst [set $var]]} {
				# man page hasn't been changed (according to mtime) -- assume everything OK
				append res ", OK"
			} else {
				# old style highlights lose
				if {!$auto && [tk_messageBox -title "Warning" -message "Highlights out of date for $f.  Delete them?" -icon question -type yesno]=="no"} {
					set $var [set tags "[file mtime $f] [lrange [set $var] 1 end]"]
				}
				append res ", out of date"
			}

			# lazily convert from old style to new
			# use after because have to draw highlights below before making new style ones
			after 1 manHighlights $w update
		}
	}
#puts stdout "v = $var, f = $f"


	### always redraw highlights (good check)
	foreach tag {halwaysvis highlight highlight-meta} {$t tag remove $tag 1.0 end}

	# show likely relevant information

	# update highlighting in text, menu
	set m [set mb $w.high].m
	$m delete 0 last

	foreach {first last} [lrange $tags 1 end] {
		if {[llength $first]>1} { set first [lfirst $first]; set last "$first+[lfirst $last]c" }
		$t tag add highlight $first $last

		# show likely relevant information
		if {$manx(tryoutline$w) && $man(highlight-show)!="never"} {nb $t $man(highlight-show) $first $last}

		if {$auto} { $t yview -pickplace $last; update idletasks; after 1000 }
		set label \
			[string range [manHighNormalize [$t get $first $last]] 0 $man(high,hcontext)]
		$m add command -label $label \
			-command "incr stat(page-highlight-go); manOutlineYview $t $first; $t yview scroll \[expr 5-\$man(high,vcontext)] units"
	}
	manShowTagDist $w highlight

	# propagate highlight information to section headers, if highlights not always visible
	if {$manx(tryoutline$w) && $man(highlight-show)!="halwaysvis"} {
#($manx(subsect-show) => always for man, never for Texinfo
		foreach now $manx(sectposns$w) next $manx(nextposns$w) {
			if {[$t tag nextrange highlight $now $next-1l]!=""} {
				for {set sup "$now.0"} {[regexp $manx(supregexp) $sup all supnum]} {set sup "js$supnum"} {
					foreach {ts te} [$t tag nextrange outline "js$supnum linestart"] break; append ts "+1c"
					# supersections may not exist
					catch {$t tag add highlight-meta $ts $te}
				}
			}
		}
	}


##	configurestate [list $mb $w.hsub] "[llength $tags]>1"
	if {[llength $tags]>1} {catch {eval $mb configure $man(highlight)}} else {$w.high configure -foreground $man(buttfg) -background $man(buttbg) -font gui}
	manHighlightsSetCmd "Hi"
	manMenuFit $m

	return $res
}


# update highlights: old to new, throw out nonexistant files
proc manHighlightsUpdate {{w .man}} {
	global high mani manx

	if ![array size high] return

	set t $w.show

	# do you need to update your highlights?
	# give opportunity iff no new style highlights, so most people only asked once
	set highup 1
	foreach i [array names high] {
		if [llength [lsecond $high($i)]]>1 { set highup 0; break }
	}
	if {!$highup || [tk_messageBox -title "Update TkMan Highlights?" -message "Do you want to update your [array size high] highlighted pages to use new style highlights that are robust to changes in the man page, automatically and in batch now?  (Otherwise they can be updated manually one by one at any time.)" -icon question -type yesno -default yes]=="no"} {
		return
	}


	wm deiconify $w
	manShowSection $w high

	rename manHighlights manHighlightsX
	proc manHighlights {args} {}

	set newform "The results below will become permanent unless you exit via \"Occasionals / Quit, don't update $manx(startup-short)\"\n\n\n"

	foreach man [array names high] {
		append newform "$man\t"

		if {[llength [lsecond $high($man)]]>1} { append newform "new style\n"; continue }

		# position old ones on spaces
		set manx(normalize) ""
		set stat [manShowMan $man]; update idletasks
		set manx(normalize) "-N"
#puts "|$stat|"
		if {$stat==""} {
			catch {unset high($man)}
			set r "doesn't exist"
# all pages supplied as full paths
#		} elseif {[string match "ERROR*" $man]} {
#			#catch {unset high($man)}
#			set r "not found"
		} else {
			set r [manHighlightsX $w get 1]
			# flush after call that resets highlights
			update

			$t yview 0
		}

		append newform "$r\n"
	}

	rename manHighlights {}
	rename manHighlightsX manHighlights

	set mani(high,form) $newform
	manShowSection $w high
}


# compose highlight data record from region of text
# want excerpt of text 
# and hook of reasonable length to search for (so may need to augment excerpt on that line)
# record format :== first-tag last-tag
# first-tag :== index excerpt pre-augment-length hook-length
# last-tag :== unnormalize-highlight-length excerpt post-augment-length hook-length
# when/if search across lines, hook-length worthless

proc manHighCompose {t first last} {
	set excerptmax 30; set hookmax 20

	scan [$t index $first] "%d.%d" fline fchar
	scan [$t index $last] "%d.%d" lline lchar
	set rlen [string length [$t get $first $last]]
	set elen [min $excerptmax $rlen]
DEBUG {puts "EXCERPTING first=$first, last=$last, rlen=$rlen, elen=$elen"}

	# compute start 
	scan [$t index [set fsi "$first linestart"]] "%d.%d" junk fstartchar
	scan [$t index [set fei "$first lineend"]] "%d.%d" junk fendchar
	set exhooklen [min $elen [expr $fendchar-$fchar+1]]
DEBUG {puts "first\tfstartchar=$fstartchar, fendchar=$fendchar, exhooklen = $exhooklen"}
	if {$exhooklen>=$hookmax} {
		# excerpted characters form substantial enough hook
		set hooklen [string length [manHighNormalize [$t get $first $first+${exhooklen}c]]]
		set prelen 0
		set excerpttxt [manHighNormalize [$t get $first $first+${elen}c]]
	} else {
		# augment excerpt if possible, at start only (for now?)
#puts "augmented"
		# when/if search across lines, don't be limited by start of line, end of line
		set prei "$first-[expr $hookmax-$exhooklen]c"; if [$t compare $prei < $fsi] { set prei $fsi }
		set excerpttxt [manHighNormalize [$t get $prei $first+${elen}c]]
		set posti "$first+${elen}c"; if [$t compare $posti > $fei] { set posti $fei }
		set hooklen [string length [manHighNormalize [$t get $prei $posti]]]
		set prelen [expr $hooklen-[string length [manHighNormalize [$t get $first $posti]]]]
	}
DEBUG {puts "|$excerpttxt|, $prelen, $hooklen"}
	set firsttag [list $first $excerpttxt $prelen $hooklen]


	# in updating from old to new style, sometimes can get empty line
	if {!$hooklen} { return "" }


	# compute end
	scan [$t index [set esi "$last linestart"]] "%d.%d" junk lstartchar
	scan [$t index [set eei "$last lineend"]] "%d.%d" junk lendchar
	set exhooklen [min $elen [expr $lchar-$lstartchar+1]]
DEBUG {puts "end\tlstartchar=$lstartchar, lendchar=$lendchar, exhooklen = $exhooklen"}
	if {$exhooklen>=$hookmax} {
		# excerpt characters form substantial enough hook
		set hooklen [string length [manHighNormalize [$t get $last-${exhooklen}c $last]]]
		set postlen 0
		set excerpttxt [manHighNormalize [$t get $last-${elen}c $last]]
	} else {
		# augment excerpt if possible
#puts "augmented"
		# when/if search across lines, don't be limited by start of line, end of line
		set posti "$last+[expr $hookmax-$exhooklen]c"; if [$t compare $posti > $eei] { set posti $eei }
		set excerpttxt [manHighNormalize [$t get $last-${elen}c $posti]]
		set prei "$last-${elen}c"; if [$t compare $prei < $esi] { set prei $esi }
		set hooklen [string length [manHighNormalize [$t get $prei $posti]]]
		set postlen [expr $hooklen-[string length [manHighNormalize [$t get $prei $last]]]]
	}
	set lasttag [list $rlen $excerpttxt $postlen $hooklen]
DEBUG {puts "|$excerpttxt|, $hooklen, $postlen"}

	return [list $firsttag $lasttag]
}


# hyphens ignored, any whitespace matches any whitespace (space matches tab, e.g.)
# essential for searching across reformats, but also good for storing in ~/.tkman

proc manHighNormalize {raw {maxlen 0}} {
	set ws "\[\t\n \]"
	set new [string trim $raw]

	# zap changebars
	regsub "\\|+\n" $new "\n" new
	#regsub -all "\n\\|" $new "\n" new
	regsub "^\\|+$ws" $new "\n" new

	# linebreaks (hyphens and whitespace) ignored and word spacing ignored
	regsub -all -- "-\n" $new "\n" new
	regsub -all "$ws+" $new " " new

	if {$maxlen} { set new [string range $new 0 $maxlen] }

	return $new
}

proc manHighRegexp {normal} {
	set regexp [stringregexpesc $normal]
	regsub -all "\[\t\n \]+" $regexp "\[\t\n |-\]*" regexp
	return $regexp
}


# try to reattach new style highlights
proc manHighlightAttach {t first firsttxt predelta fhooklen  ldelta lasttxt postdelta lhooklen   {status "GOOD"}} {
	global manx curwin
	DEBUG {puts "ATTACH: $first $firsttxt $predelta $fhooklen   $ldelta $lasttxt $postdelta $lhooklen  $status"}

	if {!$fhooklen} { set fhooktxt $firsttxt } else {
		set len [string length $firsttxt]
		set fhooktxt [string range $firsttxt 0 [expr $fhooklen-1]]
		set fextxt [string range $firsttxt $predelta end]
		set fpretxt [string range $firsttxt 0 [expr $predelta-1]]
#puts "fhooktxt=|$fhooktxt|, fextxt=|$fextxt|, fpretxt=|$fpretxt|"
	}
	if {!$lhooklen} { set lhooktxt $lasttxt } else {
		set len [string length $lasttxt]
		set lhooktxt [string range $lasttxt [expr $len-$lhooklen] end]
		set lextxt [string range $lasttxt 0 [expr $len-$postdelta-1]]
		set lhookextxt [string range $lhooktxt 0 [expr [string length $lhooktxt]-$postdelta-1]]
		set lposttxt [string range $lasttxt [expr $len-$postdelta] end]
#puts "lhooktxt=|$lhooktxt| / |$lhookextxt|, lextxt=|$lextxt|, lposttxt=|$lposttxt|"
	}

	DEBUG {puts "first = $first, |$fhooktxt|\nlast = +$ldelta, |$lhooktxt|"}


	### attach start of range

	if [$t compare $first >= end] { set first [$t index end-1l] }
	set flen [string length $fhooktxt]
	set fpt ""

	# first check for exact match for first part
	set found 0
	set fregexp [manHighRegexp $fhooktxt]
#puts "searching forward for $fregexp"
	set viz [expr {$manx(tryoutline$curwin)?"-elide":"--"}]
	# Tk doesn't search across lines!
	set ffw [$t search -forwards -regexp $viz $fregexp $first end]
	set fbk [$t search -backwards -regexp $viz $fregexp $first 1.0]
	if {$ffw=="" && $fbk==""} {
		# nothing yet
	} elseif {$ffw==""} {
		set fpt $fbk
		set found 1
		DEBUG {puts "only found backward from $first at $fbk"}
	} elseif {$fbk==""} {
		set fpt $ffw
		set found 1
		DEBUG {puts "only found foward from $first at $ffw"}
	} else {
		# matches forward and backward.  pick closer one
		scan $first "%d.%d" line char
		scan $ffw "%d.%d" fline fchar; set difffw [expr $fline-$line]; set dcfw [expr abs($fchar-$char)]
		scan $fbk "%d.%d" bline bchar; set diffbk [expr $line-$bline]; set dcbk [expr abs($char-$bchar)]
		if {$diffbk<$difffw} {set fpt $fbk} elseif {$difffw<$diffbk} {set fpt $ffw} {
			# tie, go to characters
			if {$dcbk<$dcfw} {set fpt $fbk} else {set fpt $ffw}
		}
		set found 1
		DEBUG {puts "found point $first forward ($ffw) and back ($fbk), closer is $fpt"}
	}
	scan $fpt "%d.%d" fline fchar


	# adjustments to search: disqualifications and tweaks
	if {$found} {
		if {$fhooklen} {
			# searching by hooks: verify match on excerpt
			# and get real start of highlight (controlling for spaces)

			# bump over hook context
			# this had better match!
			set must [$t search -forwards -regexp -count delta $viz [manHighRegexp $fpretxt] $fpt end]
			set fpt [$t index "$fpt+${delta}c"]

			set txt [$t get $fpt "$fpt+1000c"]
			if ![regexp -indices -- [manHighRegexp $fextxt] $txt all] { set found 0 }

		} elseif {$flen>=20} {
			# searching by long excerpt
			# if match far away, axe it, in favor of possible closer if shorter match
			if {[expr abs($line-$fline)>200]} { set found 0 }
		}
	}

	if {!$found} {
		# back off strategies:
		# if searching by hooks, dump hooks for excerpt text
		if {$fhooklen} {
			return [manHighlightAttach $t $first $fextxt 0 0  $ldelta $lasttxt $postdelta $lhooklen  $status]

		# if searching by long excerpt text, chop it and try again
		} elseif {$flen>10} {
			set chop [max 9 [expr int($flen/2)]]
			return [manHighlightAttach $t $first [string range $fhooktxt 0 $chop] 0 0  $ldelta $lasttxt $postdelta $lhooklen "DICEY"]
		} else {
			return "LOSE"
		}
	}


	### attach end of range

	# now search forward from first match to find end
	# at approximately the same number of characters forward as old one
	set found 0
	set llen [string length $lhooktxt]
	set last "$fpt+${ldelta}c-${llen}c"
	set lregexp [manHighRegexp $lhooktxt]
#puts "searching backward for $lregexp"
	set lfw [$t search -forwards -regexp -count lfwcnt $viz $lregexp $last end]
	set lbk [$t search -backwards -regexp -count lbkcnt $viz $lregexp $last $fpt]
	if {$lfw=="" && $lbk==""} {
	} elseif {$lfw==""} {
		set lpt $lbk
		set llen $lbkcnt
		set found 1
		DEBUG {puts "end only found backward from $fpt at $lbk"}
	} elseif {$lbk==""} {
		set lpt $lfw
		set llen $lfwcnt
		set found 1
		DEBUG {puts "end only found foward from $fpt at $lfw"}
	} else {
		# match forward and backward.  pick closer one -- need to adjust for length of match
		scan $fpt "%d.%d" line char
		scan $lfw "%d.%d" fline fchar; set difffw [expr $fline-$line]; set dcfw [expr abs($fchar-$char)]
		scan $lbk "%d.%d" bline bchar; set diffbk [expr $line-$bline]; set dcbk [expr abs($char-$bchar)]
		if {$diffbk<$difffw} {set lpt $lbk; set llen $lbkcnt} elseif {$difffw<$diffbk} {set lpt $lfw; set llen $lfwcnt} {
			# tie, go to characters
			if {$dcbk<$dcfw} {set lpt $lbk; set llen $lbkcnt} else {set lpt $lfw; set llen $lfwcnt}
		}
		set found 1
		DEBUG {puts "found end point $fpt forward ($lfw) and back ($lbk), closer is $lpt"}
	}
	

	if {$found} {
		if {$lhooklen} {
			# should make this check when do $t search ...
			# match only as far as excerpt (not hook) -- chop off trailing context
			set e [manHighRegexp $lhookextxt]
			# this had better match!
			set posti [$t search -count llen -regexp $viz $e $lpt end]
			DEBUG {puts "$t search -count llen -regexp $viz $e $lpt end"}
			# off by one error in searching backwards
#			DEBUG {puts "backward must = $must, delta=$delta, llen=$llen"}
#			set llen [string length [$t get $fpt "$lpt+${len}c"]]
#			incr llen -$delta


			set e [manHighRegexp $lextxt]; append e "\$"
			set txt [$t get "$lpt-1000c" "$lpt+${llen}c"]
#puts "backward regexp [regexp $e $txt]: find |$lextxt| in |[string range $txt [expr [string length $txt]-100] end]|"
			if ![regexp -indices -- $e $txt all] { set found 0 }
#puts "*** no match to excerpt"; #
		}

		set nldelta [string length [$t get $fpt "$lpt+${llen}c"]]

		if {$llen>=20} {
			# if new end too far down, assume it was searching for common text 
			# and latched onto an unsuspecting host
			if {$nldelta>[expr 10*$ldelta]} { set found 0 }
		}
	}

	if {!$found} {
		if {$lhooklen} {
			return [manHighlightAttach $t $fpt $firsttxt $predelta $fhooklen   $ldelta $lextxt 0 0  $status]

		} elseif {$llen>10} {
			set chop [max 9 [expr int($llen/2)]]
			# keep end $chop characters
			set d [expr $llen-$chop]; set lhooktxt [string range $lhooktxt $d end]
			return [manHighlightAttach $t $fpt $firsttxt $predelta $fhooklen  $ldelta $lhooktxt 0 0  "DICEY"]

		} else {
			#return "LOSE"
			# if didn't find the end, just assume it's the same distance away that it used to be
			set nldelta $ldelta
			set status DICEY
		}
	}


	# got a match
	return [list $status $fpt $nldelta]
}