/* ==================================================================

    FILE: "/home/joze/src/tclreadline/tclreadline.c"
    LAST MODIFICATION: "Wed Sep 15 01:00:43 1999 (joze)"
    (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
    $Id$
    ---

    tclreadline -- gnu readline for tcl
    Copyright (C) 1999  Johannes Zellner

            int i, length;
            matches = (char**) MALLOC(sizeof(char*) * (objc + 1));
            for (i = 0; i < objc; i++) {
                matches[i] = strdup(Tcl_GetStringFromObj(objv[i], &length));
                if (1 == objc && !strlen(matches[i])) {
                    FREE(matches[i]);
                    FREE(matches);
                    Tcl_ResetResult(tclrl_interp); /* clear result space */
                    return (char**) NULL;
                }
            }

            /**
             * this is a special one:
             * if the script returns exactly two arguments

# -*- tclsh -*-
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 02:59:18 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#

#**
# TryFromList will return an empty string, if
# the text typed so far does not match any of the
# elements in list. This might be used to allow
# subsequent filename completion by the builtin
# completer.
# If inhibit is non-zero, the result will be
# formatted such that readline will not insert
# a space after a complete (single) match.
#
proc TryFromList {text lst {allow ""} {inhibit 0}} {

    # puts stderr "(CompleteFromList) \ntext=|$text|"
    # puts stderr "(CompleteFromList) lst=|$lst|"
    set pre [GetQuotedPrefix ${text}]
    set matches [MatchesFromList $text $lst $allow]

    # puts stderr "(CompleteFromList) matches=|$matches|"
    if {1 == [llength $matches]} { ; # unique match
        # puts stderr \nunique=$matches\n
        # puts stderr "\n|${pre}${matches}[Right ${pre}]|\n"
        set null [string index $matches 0]
        if {"<" == $null || "?" == $null} {
			set completion [string trim "[list $text] $lst"]
        } else {
			set completion [string trim ${pre}${matches}[Right ${pre}]]
		}
		if {$inhibit} {
			return [list $completion {}]
		} else {
			return $completion
        }
    } elseif {"" != ${matches}} {
        # puts stderr \nmore=$matches\n
        set longest [CompleteLongest ${matches}]
        # puts stderr longest=|$longest|
        if {"" == $longest} {
            return [string trim "[list $text] ${matches}"]
        } else {
            return [string trim "${pre}${longest} ${matches}"]
        }
    } else {
        return ""; # nothing to complete
    }
}

#**
# CompleteFromList will never return an empty string.
# completes, if a completion can be done, or ring
# the bell if not. If inhibit is non-zero, the result
# will be formatted such that readline will not insert
# a space after a complete (single) match.
#
proc CompleteFromList {text lst {inhibit 0}} {
	set result [TryFromList ${text} ${lst} "" $inhibit]
    if {![llength ${result}]} {
        Alert
        # return [string trim [list ${text}] ${lst}"]
        if {[llength ${lst}]} {
            return [string trim "${text} ${lst}"]
        } else {
            return [string trim [list ${text} {}]]

    } else {

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

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

                }
            }
            default {
                set sub [Lindex $line 1]
                switch -- $sub {
                    configure -
                    cget {
						return [CompleteFromOptions \
						${part} ${start} ${line} ${alias}]
                    }
                }
            }
        }


        # no specific command completer found.

        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]} {
        return "$text "; # append a space after a closing ')'
    }

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

        abs  -

            switch -- $cmd {
                children -
                export -
                forget -
                import { return [DisplayHints ?pattern?] }
                delete { return [TryFromList ${mod} $space_matches] }
                eval -
				inscope {
					return [BraceOrControlStatement \
					$text $start $end $line $pos $mod]
				}
                which { return [CompleteFromList ${mod} {-variable <name>}] }
            }
        }
        4 {
            switch -- $cmd {
                export -
                forget -

# -------------------------------------
#                  TK
# -------------------------------------

# GENERIC WIDGET CONFIGURATION

proc WidgetChildren {{pattern .}} {
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {![string length ${pattern}]} {
        set pattern .
    }
    if {[winfo exists ${pattern}]} {
		return [concat ${pattern} [winfo children ${pattern}]]
    } else {
        regsub {.[^.]*$} $pattern {} pattern
        if {[winfo exists ${pattern}]} {
			return [concat ${pattern} [winfo children ${pattern}]]
        } else {
            return ""
        }
    }
}

proc WidgetDescendants {{pattern .}} {
    set tree [WidgetChildren ${pattern}]
    foreach widget $tree {
        append tree " [WidgetDescendants $widget]"
    }
    return $tree
}

# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
    upvar $optionsT options
    # first we build an option table
    #
	if {[catch [list set option_table [${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]
        }
    }
	return [llength ${option_table}]
}

#**
# try to complete a `cmd configure|cget ..' from the command's options.
# @param text start line cmd, standard tclreadlineCompleter arguments.
# @return a tclreadline completer formatted string.



# @date Sep-14-1999
#
proc CompleteFromOptions {text start line cmd} {

    set prev [PreviousWord ${start} ${line}]

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


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

			# complete only if the user has not
			# already entered something here.
			#
        if {![llength ${text}]} {
				# use this double list to quote option
				# values which have to be quoted.
				#
				return [list [list [lindex $options(value) ${found}]]]
        }

    } else {
			return [CompleteFromList ${text} \
			[RemoveUsedOptions $line $options(switches)]]
		}
    }
}

proc complete(WIDGET) {text start end line pos mod} {
	set widget [Lindex ${line} 0]
	set cmd [Lindex ${line} 1]

    switch -- $pos {
        1 {
            set cmds [TrySubCmds ${widget}]
            if {[llength ${cmds}]} {
                return [TryFromList ${mod} ${cmds}]
            }
        }
		default {
            if {([string match ${cmd}* cget] || \
                [string match ${cmd}* configure])
            } {
                return [CompleteFromOptions ${text} ${start} ${line} ${widget}]
            }
        }
    }

            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 .]}]} {
				set toplevelClass ""
			}
			set rest {
				Button Canvas Checkbutton Entry Frame Label
				Listbox Menu Menubutton Message Radiobutton
				Scale Scrollbar Text
				all
			}
			return [CompleteFromList ${text} \
			[concat $toplevels $widgets $toplevelClass $rest]]
		}
		2 {
			if {![string length ${text}]} {
				# insert a < and inhibit further completion
				return [list < {}]
			} elseif {[regexp > ${text}]} {
				set diff [expr [CountChar ${text} <] - [CountChar ${text} >]]
				for {set i 0} {$i < $diff} {incr i} {
					append text >
				}
				append text " "
				return ${text}
			} else {
				regexp -- {^(.*[<-])([^<-]*)} ${text} all left right
			}
			set modifiers {
				Alt Control Shift Lock Double Triple
				B1 B2 B3 B4 B5 Button1 Button2 Button3 Button4 Button5
				M M1 M2 M3 M4 M5        
				Meta Mod1 Mod2 Mod3 Mod4 Mod5
			}
			set events {
				Activate Button ButtonPress ButtonRelease
				Circulate Colormap Configure Deactivate Destroy
				Enter Expose FocusIn FocusOut Gravity
				Key KeyPress KeyRelease Leave Map Motion
				MouseWheel Property Reparent Unmap Visibility
			}
			set sequence [concat $modifiers $events]
			set exact_matches [MatchesFromList ${right} ${sequence}]
			# TODO this is awkward. Think of making it better!
			#
			if {1 == [llength ${exact_matches}] && \
				-1 != [lsearch ${sequence} ${right}]
			} {
				set completion [CompleteFromList ${right} {> -} 1]
			} else {
				set completion [CompleteFromList ${right} $sequence 1]
			}
			if {![string length [lindex $completion 0]]} {
				return [concat ${left} [lrange $completion 1 end]]
			} else {
				return ${left}${completion}
			}
		}
		3 {
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
		}
	}
	return ""
}

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