# urlentry.tcl
#
# Keystroke bindings to select a URL
#

# These are the bindings on the status entry widget
proc UrlEntry_Setup { e {l {}} } {
    global urlentry
    catch {unset urlentry}
    bindtags $e [list $e UrlEntry$l Entry]
    bind UrlEntry$l <Button-1>	{catch {unset urlentry(match)}}
    bind UrlEntry$l <Any-Key>	[list UrlEntryTypein %W %A $l]
    bind UrlEntry$l <Key-Right>	{ # fall through to Entry }
    bind UrlEntry$l <Key-Left>	{ # fall through to Entry }
    bind UrlEntry$l <space>	[list UrlEntryComplete %W $l]
    bind UrlEntry$l <Tab>	[list UrlEntryComplete %W $l]
    bind UrlEntry$l <BackSpace>	[list UrlEntryBackSpace %W $l]
    bind UrlEntry$l <Control-h>	[list UrlEntryBackSpace %W $l]
    bind UrlEntry$l <Delete>	[list UrlEntryBackSpace %W $l]
    bind UrlEntry$l <Control-u>	[list UrlEntryClear %W $l]
    bind UrlEntry$l <Control-Key> [list UrlEntryEdit %W $l]
    bind UrlEntry$l <Meta-Key>	[list UrlEntryEdit %W $l]
}
proc UrlEntryTypein {w a l} {
    global urlentry
    if {$a == {}} {
	return -code break
    }
    catch {$w delete sel.first sel.last}
    if [info exists urlentry(match)] {
	set urlentry(sel) $urlentry(match)
	unset urlentry(match)
	catch {unset urlentry(allurls)}
    }
    if ![info exists urlentry(sel)] {
	set urlentry(sel) [$w get]
    }
    # Have to do this because the textvariable may be used by someone different
    set i [$w index insert]
    set val [$w get]
    set urlentry(sel) [string range $val 0 [incr i -1]] 
    append urlentry(sel) $a [string range $val [incr i] end]
    $w delete 0 end
    $w insert 0 $urlentry(sel)
    $w icursor [incr i]
    catch {UrlEntryComplete $w $l 1}
    return -code break
}
proc UrlEntryBackSpace { w l } {
    global urlentry
    catch {unset urlentry(nomatch)}
    if ![catch {$w delete sel.first sel.last}] {
	set urlentry(sel) [$w get]
	catch {unset urlentry(match)}
	return
    }
    if [info exists urlentry(match)] {
	set urlentry(sel) $urlentry(match)
	unset urlentry(match)
	catch {unset urlentry(allurls)}
    }
    if ![info exists urlentry(sel)] {
	set urlentry(sel) [$w get]
    }
    set i [$w index insert]
    set val [$w get]
    set urlentry(sel) [string range $val 0 [expr $i-2]] 
    append urlentry(sel) [string range $val $i end]
    $w delete 0 end
    $w insert 0 $urlentry(sel)
    $w icursor [expr $i-1]
    return -code break
}
proc UrlEntryComplete { w l {listonly 0} } {
    global urlentry History
    if ![info exists urlentry(sel)] {
	set urlentry(sel) [$w get]
    }
    if {[info exists urlentry(nomatch)]} {
	if {[string match $urlentry(nomatch)* $urlentry(sel)] ||
	    [string match $urlentry(sel)* $urlentry(nomatch)]} {
	    return -code break
	}
	unset urlentry(nomatch)
    }
    if ![info exists urlentry(allurls)] {
	set urlentry(allurls) [lsort [array names History]]
	set urlentry(ix) 0
    }
    foreach f [lrange $urlentry(allurls) $urlentry(ix) end] {
	if [info exists hit] {
	    # Skip over all entries that match the current hit.
	    if ![string match $hit* $f] {
		return -code break
	    }
	} else {
	    if [string match $urlentry(sel)* $f] {
		if {$l != {}} {
		    $l select clear 0 end
		    $l select set $urlentry(ix)
		    $l see $urlentry(ix)
		}
		if !$listonly {
		    # Find the shortest subset of the path that still
		    # matches and extends the user input.
		    set parent [Url_Parent $f]
		    while {[string match $urlentry(sel)* $parent]} {
			set f $parent
			set parent [Url_Parent $f]
		    }
		    if {![info exists urlentry(match)] ||
			[string compare $f $urlentry(match)] != 0} {
			set urlentry(match) $f 
			$w delete 0 end
			$w insert 0 $f
			set hit $f
		    }
		} else {
		    return -code break
		}
	    }
	}
	incr urlentry(ix)
    }
    if ![info exists hit] {
	if {[info exists urlentry(match)]} {
	    set urlentry(ix) 0
	} else {
	    # Failed to match - don't bother looking until more input
	    set urlentry(nomatch) [$w get]
	    unset urlentry(allurls)
	    catch {unset urlentry(match)}
	    if !$listonly {
		$w delete 0 end
		$w insert 0 $urlentry(sel)
	    }
	}
    } elseif {[string match $hit* $f]} {
	set urlentry(ix) 0
    } else {
	# nothing
    }
    return -code break
}
proc UrlEntryAccept { w l } {
    global urlentry
    catch {set urlentry(sel) $urlentry(match)}
    catch {UrlEntryComplete $w $l}
    return -code break
}
proc UrlEntryClear { w l } {
    global urlentry
    set urlentry(sel) {}
    $w delete 0 end
    if {$l != {}} {
	$l select clear 0 end
    }
    return -code break
}
proc UrlEntryEdit { w l } {
    global urlentry
    set urlentry(sel) {}
    catch {unset urlentry(match)}
}
