# -*- tclsh -*-
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Thu Sep 16 22:17:38 1999 (joze)"
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Fri Sep 17 18:41:10 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

# TODO:
#
#	- tcltest is missing
#	- better completion for CompleteListFromList:
#	  RemoveUsedOptions ...
#	- namespace eval fred {... <-- continue with a 
#								   substitution in fred.
#	- set tclreadline::pro<tab> geht *nicht*
#	  set ::tclreadline::pro<tab> geht
#
#



namespace eval tclreadline {

# @date Sep-14-1999
#
proc TrySubCmds {cmd} {
	set trystring ____
	set result ""
	if [catch {set result [eval ${cmd} ${trystring}]} msg] {
		set tcmd [string trim ${cmd}]
		# puts stderr msg=$msg
		if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
		if {[regexp {(bad|ambiguous) .*"____": *must *be( .*$)} ${msg} \
			all junk raw]
		} {; # XXX see tclIndexObj.c XXX
			regsub -all -- , ${raw} { } raw
			set len [llength ${raw}]
			set len_2 [expr ${len} - 2]
			for {set i 0} {${i} < ${len}} {incr i} {
				set word [lindex ${raw} ${i}]
				if {"or" != ${word} && ${i} != ${len_2}} {
					lappend result ${word}
				}

			}
		} elseif {[regexp "wrong # args: should be \"${tcmd}\(.*\)\"" \
			${msg} all hint]
		} {
		} {; # XXX see tclIndexObj.c XXX
			set result [string trim $hint]
		} else {
			# check, if it's a blt error msg ...
			#
			set msglst [split ${msg} \n]
			foreach line ${msglst} {
				if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \

proc SplitLine {start line} {
	set depth 0
	# puts stderr SplitLine
	for {set i $start} {$i >= 0} {incr i -1} {
		set c [string index $line $i]
		if {{;} == $c} {
			incr i; # discard command break character
			return [list [expr $start - $i] [string range $line $i end]]
			return [list [expr $start - $i] [String range $line $i end]]
		} elseif {{]} == $c} {
			incr depth
		} elseif {{[} == $c} {
			incr depth -1
			if {$depth < 0} {
				incr i; # discard command break character
				return [list [expr $start - $i] [string range $line $i end]]
				return [list [expr $start - $i] [String range $line $i end]]
			}
		}
	}
	return ""
}

proc IsWhite {char} {

	set last [expr [string length $line] - 1]
	for {set i $last} {$i >= 0} {incr i -1} {
		if {![catch {llength [string range $line 0 $i]}]} {
			break
		}
	}
	incr i
	return [string range $line $i end]
	return [String range $line $i end]
}

#**
# save `lindex'. works also for non-complete lines
# with opening parentheses or quotes.
# usage as `lindex'.
# Eventually returns the Rest of an incomplete line,

	if {[catch [list set len [llength $line]]]} {
		set line [ProperList $line]
		if {[catch [list set len [llength $line]]]} { return {} }
	}
	# puts stderr \nline=$line
	return $len
}

#**
# string function, which works also for older versions
# of tcl, which don't have the `end' index.
#
proc String args {
	if {[info tclversion] < 8.2} {
		switch [lindex $args 1] {
			range -
			index {
				if {"end" == [lindex $args end]} {
					set str [lindex $args 2]
					lreplace args end end [expr [string length $str] - 1]
				}
			}
		}
	}
	return [eval string $args]
}

proc StripPrefix {text} {
	# puts "(StripPrefix) text=|$text|"
	set null [string index $text 0]
	if {"\"" == $null || "\{" == $null} {
		return [string range $text 1 end]
		return [String range $text 1 end]
	} else {
		return $text
	}
}

proc VarCompletion {text {level -1}} {
	if {-1 == ${level}} {

		}
		set pos [expr ${idx} + 1]
	}

	if {![info exists cmd]} {return}
	if {![info complete ${cmd}]} {return}
	set cmd [string range ${cmd} 1 [expr [string length ${cmd}] - 2]]
	set rest [string range ${line} [expr ${idx} + 1] end]
	set rest [String range ${line} [expr ${idx} + 1] end]

	if {[catch [list set result [string trim [eval ${cmd}]]]]} {return}

	set line ${result}${rest}
	set diff [expr [string length ${result}] - ([string length ${cmd}] + 2)]
	incr start ${diff}
	incr end ${diff}

				return ""
			}
		}
		# variable completion. Check first, if the
		# variable starts with a plain `$' or should
		# be enclosed in braces.
		#
		set var [string range $part 1 end]
		set var [String range $part 1 end]

		# check if $var is an array name, which
		# already has already a "(" somewhere inside.
		#
		if {"" != [set vc [VarCompletion $var]]} {
			if {"" == [lindex $vc 0]} {
				return "\$ [lrange ${vc} 1 end]"

		return [TryFromList $part $all]

	} else {

		# try to use $pos further ...
		# puts stderr |$line|
		#
		if {"." == [string index [string trim ${line}] 0]} {
			set alias WIDGET
			set namespc ""; # widgets are always in the global
		} else {
		# if {"." == [string index [string trim ${line}] 0]} {
		# 	set alias WIDGET
		# 	set namespc ""; # widgets are always in the global
		# } else {

			# the double `lindex' strips {} or quotes.
			# the subst enables variables containing
			# command names.
			#
			set alias [uplevel [info level] \
			subst [lindex [lindex [QuoteQuotes ${line}] 0] 0]]

			}

			# strip leading ::'s.
			#
			regsub -all {^::} $alias {} alias
			set namespc [namespace qualifiers $alias]
			set alias [namespace tail $alias]
		}
		# }

		# try first a specific completer, then, and only then
		# the tclreadline_complete_unknown.
		#
		foreach cmd [list ${alias} tclreadline_complete_unknown] {
			# puts stderr ${namespc}complete(${cmd})
			if {"" != [namespace eval ::tclreadline::${namespc} \

		atan    exp     log10   tan 
		atan2   floor   pow     tanh 
		ceil    fmod    sin     abs 
		double  int     rand    round 
		srand 
	}

	if {[info tclversion] >= 8.2} {
		set end end
	} else {
		set end [expr [string length $text] - 1]
	}
	if {")" == [string index $text $end] && -1 != [lsearch $cmds $left]} {
	if {")" == [String index $text end] && -1 != [lsearch $cmds $left]} {
		return "$text "; # append a space after a closing ')'
	}

	switch -- $left {
		rand { return "rand() " }

		abs  -

			switch -- $cmd {
				read {}
				initialize {}
				write {}
				add { return [DisplayHints <completerLine>] }
				completer { return [DisplayHints <line>] }
				customcompleter { return [DisplayHints ?scriptCompleter?] }
				builtincompleter { return [DisplayHints ?boolean?] }
				builtincompleter { return [CompleteBoolean ${text}] }
				eofchar { return [DisplayHints ?script?] }
				reset-terminal {
					if {[info exists ::env(TERM)]} {
						return [CompleteFromList ${text} $::env(TERM)]
					} else {
						return [DisplayHints ?terminalName?]
					}

# @param command.
# @param optionsT where the table will be stored.
# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
	upvar $optionsT options
	# first we build an option table
	# first we build an option table.
	# We always use `configure' here,
	# because cget will not return the
	# option table.
	#
	if {[catch [list set option_table [eval ${cmd}]] msg]} {
	if {[catch [list set option_table [eval ${cmd} configure]] msg]} {
		return 0
	}
	foreach optline ${option_table} {
		if {5 != [llength ${optline}]} continue else {
			lappend options(switches) [lindex ${optline} 0]
			lappend options(value)    [lindex ${optline} 4]
		}

		if {-1 != ${idx}} {
			break
		}
	}
	if {-1 == ${idx}} {
		return
	}

	# separate the command, but exclude (cget|configure)
	# because cget won't return the option table. Instead
	# OptionTable always uses `configure' to get the
	# option table.
	#
	set cmd [lrange ${lst} 0 ${idx}]
	# puts stderr cmd=|$cmd|
	set cmd [lrange ${lst} 0 [expr ${idx} - 1]]

	TraceText $cmd
	if {0 < [OptionTable ${cmd} options]} {

		set prev [PreviousWord ${start} ${line}]
		if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {

			# complete only if the user has not
			# already entered something here.

}

proc CompleteFromOptionsOrSubCmds {text start end line pos} {
	set from_opts [CompleteFromOptions ${text} ${start} ${line}]
	if {[string length ${from_opts}]} {
		return ${from_opts}
	} else {
		# puts stderr \n\n[lrange [ProperList ${line}] 0 [expr $pos - 1]]\n
		set cmds [TrySubCmds [lrange [ProperList ${line}] 0 [expr $pos - 1]]]
		# puts stderr cmds=|$cmds|
		if {[llength ${cmds}]} {
			return [TryFromList ${text} ${cmds}]
		}
	}
	return ""
}

proc complete(WIDGET) {text start end line pos mod} {
	# set widget [Lindex ${line} 0]
	# set cmds [TrySubCmds ${widget}]
	# if {[llength ${cmds}]} {
	# 	return [TryFromList ${mod} ${cmds}]
	# }
# TODO
	return [CompleteFromOptionsOrSubCmds ${text} ${start} ${end} ${line} ${pos}]
}

# write a dispatcher here, which gets the widget class name
# SPECIFIC TK COMMAND COMPLETERS

proc complete(bell) {text start end line pos mod} {
# and calls specific completers.
#
proc complete(WIDGET_COMMAND) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [CompleteFromList ${text} -displayof] }
	return [CompleteFromOptionsOrSubCmds ${text} ${start} ${end} ${line} ${pos}]
		2 {
			if {"-displayof" == [PreviousWord ${start} ${line}]} {
				return [CompleteFromList ${text} [ToplevelWindows]]
			}
		}
}

	}
}

proc EventuallyInsertLeadingDot {text fallback} {
	if {![string length ${text}]} {
		return [list . {}]
	} else {
		return [DisplayHints $fallback]
	}
}

#**
# TODO: shit. make this better!
# @param text, a std completer argument (current word).
# @param fullpart, the full text of the current position.
# @param lst, the list to complete from.
# @param pre, leading `quote'.
# @param sep, word separator.
# @param post, trailing `quote'.
# @param  text, a std completer argument (current word).
# @param  fullpart, the full text of the current position.
# @param  lst, the list to complete from.
# @param  pre, leading `quote'.
# @param  sep, word separator.
# @param  post, trailing `quote'.
# @return a formatted completer string.
# @date Sep-15-1999
# @date   Sep-15-1999
#
proc CompleteListFromList {text fullpart lst pre sep post} {

	# puts stderr ""
	# puts stderr text=|$text|
	# puts stderr lst=|$lst|
	# puts stderr pre=|$pre|

	} elseif {[string length ${left}]} {
		return [list ${left}]${completion}
	} else {
		return ${completion}
	}
	return ""
}

#**
# SpecificSwitchCompleter
# ---
# @param    text   -- the word to complete.
# @param    start  -- the char index of text's start in line
# @param    line   -- the line gathered so far.
# @param    switch -- the switch to complete for.
# @return   a std tclreadline formatted completer string.
# @sa       CompleteWidgetConfigurations
# @date     Sep-17-1999
#
proc SpecificSwitchCompleter {text start line switch} {
	# TODO:
	#   go to the `options' man page and look for possible values
	switch -- ${switch} {
		-takefocus -
		-exportselection { return [CompleteBoolean ${text}] }
		-xscrollcommand -
		-yscrollcommand {
			# return [BraceOrCommand ${text} \
			# ${start} ${end} ${line} ${pos} ${mod}]
		}
		-relief {
			return [CompleteFromList ${text} {
				raised sunken flat ridge solid groove
			}]
		}
		default { return [DisplayHints <[String range ${prev} 1 end]>] }
	}
}

#**
# CompleteWidgetConfigurations
# ---
# @param    text  -- the word to complete.
# @param    start -- the actual cursor position.
# @param    line  -- the line gathered so far.
# @param    lst   -- a list of possible completions.
# @return   a std tclreadline formatted completer string.
# @sa       SpecificSwitchCompleter
# @date     Sep-17-1999
#
proc CompleteWidgetConfigurations {text start line lst} {
	set prev [PreviousWord ${start} ${line}]
	if {"-" == [string index ${prev} 0]} {
		return [SpecificSwitchCompleter ${text} ${start} ${line} ${prev}]
	} else {
		return [CompleteFromList ${text} \
		[RemoveUsedOptions ${line} ${lst}]]
	}
}

# --------------------------------------
# === SPECIFIC TK COMMAND COMPLETERS ===
# --------------------------------------

proc complete(bell) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [CompleteFromList ${text} -displayof] }
		2 {
			if {"-displayof" == [PreviousWord ${start} ${line}]} {
				return [CompleteFromList ${text} [ToplevelWindows]]
			}
		}
	}
}

proc complete(bind) {text start end line pos mod} {
	switch -- ${pos} {
		1 {
			set widgets [WidgetChildren ${text}]
			set toplevels [ToplevelWindows]
			if {[catch {set toplevelClass [winfo class .]}]} {

			return [CompleteListFromList ${text} [Lindex ${line} 2] \
			[bindtags [Lindex ${line} 1]] \{ { } \}]
		}
	}
	return ""
}

proc CompleteWidgetConfigurations {text start line lst} {
	prev [PreviousWord ${start} ${line}]
}

proc complete(button) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -activeforeground -anchor
				-background -bitmap -borderwidth -cursor
				-disabledforeground -font -foreground
				-highlightbackground -highlightcolor
				-highlightthickness -image -justify
				-padx -pady -relief -takefocus -text
				-textvariable -underline -wraplength
				-command -default -height -state -width
			}]
		}
	}
	return ""
}

proc complete(canvas) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-background -borderwidth -cursor -highlightbackground
				-highlightcolor -highlightthickness -insertbackground
				-insertborderwidth -insertofftime -insertontime
				-insertwidth -relief -selectbackground -selectborderwidth
				-selectforeground -takefocus -xscrollcommand -yscrollcommand
				-closeenough -confine -height -scrollregion -width
				-xscrollincrement -yscrollincrement
			}]
		}
	}
	return ""
}

proc complete(checkbutton) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground activeBackground Foreground 
				-activeforeground -anchor -background -bitmap
				-borderwidth -cursor -disabledforeground -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -image -justify -padx -pady
				-relief -takefocus -text -textvariable -underline
				-wraplength -command -height -indicatoron -offvalue
				-onvalue -selectcolor -selectimage -state -variable
				-width
			}]
		}
	}
	return ""
}

proc complete(entry) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-background -borderwidth -cursor -exportselection
				-font -foreground -highlightbackground -highlightcolor
				-highlightthickness -insertbackground -insertborderwidth
				-insertofftime -insertontime -insertwidth -justify -relief
				-selectbackground -selectborderwidth -selectforeground
				-takefocus -textvariable -xscrollcommand -show -state
				-width
			}]
		}
	}
	return ""
}

proc complete(frame) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-borderwidth -cursor -highlightbackground -highlightcolor
				-highlightthickness -relief -takefocus -background
				-class -colormap -container -height -visual -width
			}]
		}
	}
	return ""
}

proc complete(label) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-anchor -background -bitmap -borderwidth -cursor -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -image -justify -padx -pady -relief
				-takefocus -text -textvariable -underline -wraplength
				-height -width
			}]
		}
	}
	return ""
}

proc complete(listbox) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-background -borderwidth -cursor -exportselection -font
				-foreground -height -highlightbackground -highlightcolor
				-highlightthickness -relief -selectbackground
				-selectborderwidth -selectforeground -setgrid -takefocus
				-width -xscrollcommand -yscrollcommand -height -selectmode
				-width
			}]
		}
	}
	return ""
}

proc complete(menu) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -activeborderwidth -activeforeground
				-background -borderwidth -cursor -disabledforeground
				-font -foreground -relief -takefocus -postcommand
				-selectcolor -tearoff -tearoffcommand -title -type
			}]
		}
	}
	return ""
}

proc complete(menubutton) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -activeforeground -anchor -background
				-bitmap -borderwidth -cursor -disabledforeground -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -image -justify -padx -pady -relief
				-takefocus -text -textvariable -underline -wraplength
				-direction -height -indicatoron -menu -state -width
			}]
		}
	}
	return ""
}

proc complete(message) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-anchor -background -borderwidth -cursor -font -foreground
				-highlightbackground -highlightcolor -highlightthickness
				-padx -pady -relief -takefocus -text -textvariable -width 
				-aspect -justify -width
			}]
		}
	}
	return ""
}

proc complete(radiobutton) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -activeforeground -anchor -background
				-bitmap -borderwidth -cursor -disabledforeground -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -image -justify -padx -pady -relief
				-takefocus -text -textvariable -underline -wraplength -command
				-height -indicatoron -selectcolor -selectimage -state -value
				-variable -width
			}]
		}
	}
	return ""
}

proc complete(scale) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -background -borderwidth -cursor -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -orient -relief -repeatdelay
				-repeatinterval -takefocus -troughcolor -bigincrement
				-command -digits -from -label -length -resolution
				-showvalue -sliderlength -sliderrelief -state -tickinterval
				-to -variable -width
			}]
		}
	}
	return ""
}

proc complete(scrollbar) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-activebackground -background -borderwidth -cursor
				-highlightbackground -highlightcolor -highlightthickness
				-jump -orient -relief -repeatdelay -repeatinterval
				-takefocus -troughcolor -activerelief -command
				-elementborderwidth -width
			}]
		}
	}
	return ""
}

proc complete(text) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-background -borderwidth -cursor -exportselection -font
				-foreground -highlightbackground -highlightcolor
				-highlightthickness -insertbackground -insertborderwidth
				-insertofftime -insertontime -insertwidth -padx -pady
				-relief -selectbackground -selectborderwidth
				-selectforeground -setgrid -takefocus -xscrollcommand
				-yscrollcommand -height -spacing1 -spacing2 -spacing3
				-state -tabs -width -wrap
			}]
		}
	}
	return ""
}

proc complete(toplevel) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
		default {
			return [CompleteWidgetConfigurations ${text} ${start} ${line} {
				-borderwidth -cursor -highlightbackground -highlightcolor
				-highlightthickness -relief -takefocus -background
				-class -colormap -container -height -menu -screen
				-use -visual -width
			}]
		}
	}
	return ""
}

proc complete(image) {text start end line pos mod} {
	set sub [Lindex ${line} 1]
set sub [Lindex ${line} 1]
	switch -- ${pos} {
		1 { return [CompleteFromList ${text} [TrySubCmds image]] }
		2 {
			switch -- ${sub} {
				create { return [CompleteFromList ${text} [image types]] }
				delete -
				height -