#############################################################################
# $Id: input.tcl,v 1.14 2002/11/05 06:18:27 cgavin Exp $
#
# input.tcl - procedures for prompting windowed string input
#
# Copyright (C) 1996-1998 Stewart Allen
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

##############################################################################
#

proc vTcl:get_string {title target {value ""}} {
    global vTcl
    set tmpname .vTcl.[vTcl:rename $target]
    set vTcl(x,$tmpname) ""
    vTcl:string_window $title $tmpname $value
    tkwait window $tmpname
    return $vTcl(x,$tmpname)
}

proc vTcl:set_string {base str} {
    global vTcl
    set vTcl(x,$base) $str
    grab release $base
    destroy $base
}

proc vTcl:snarf_string {base} {
    global vTcl
    vTcl:set_string $base "[$base.ent18 get]"
}

proc vTcl:string_window {title base {value ""}} {
    global vTcl

    vTcl:check_mouse_coords

    toplevel $base
    wm transient $base .vTcl
    wm focusmodel $base passive
    wm geometry $base 225x49+[expr $vTcl(mouse,X)-120]+[expr $vTcl(mouse,Y)-20]
    wm maxsize $base 500 870
    wm minsize $base 225 1
    wm overrideredirect $base 0
    wm resizable $base 1 0
    wm deiconify $base
    wm title $base "$title"
    frame $base.fra19 \
        -borderwidth 1 -height 30 -relief sunken -width 30
    pack $base.fra19 \
        -in $base -anchor center -expand 1 -fill both -ipadx 0 -ipady 0 \
        -padx 0 -pady 0 -side top
    ::vTcl::CancelButton $base.fra19.but21 -command "
	$base.ent18 delete 0 end
	vTcl:set_string \{$base\} \"\"
    "
    pack $base.fra19.but21 \
        -in $base.fra19 -anchor center -expand 0 -fill none -ipadx 0 \
        -ipady 0 -padx 0 -pady 0 -side right
    ::vTcl::OkButton $base.fra19.but20 -command "vTcl:snarf_string \{$base\}"
    pack $base.fra19.but20 \
        -in $base.fra19 -anchor center -expand 0 -fill none -ipadx 0 \
        -ipady 0 -padx 0 -pady 0 -side right
    vTcl:entry $base.ent18 \
        -cursor {} -background white
    pack $base.ent18 \
        -in $base -anchor center -expand 0 -fill x -ipadx 0 -ipady 0 \
        -padx 0 -pady 0 -side top
    bind $base <Key-Return> "vTcl:snarf_string \{$base\}; break"
    bind $base <Key-Escape> "$base.fra19.but21 invoke"
    $base.ent18 insert end $value
    update idletasks
    focus $base.ent18
    grab $base
}

proc vTcl:set_label {t} {
    global vTcl
    if {$t == ""} {return}
    if [catch {set txt [$t cget -text]}] {
        return
    }
    set label [vTcl:get_string "Setting label for $t" $t $txt]
    if {$label == ""} {
        return
    }
    $t conf -text $label
    vTcl:place_handles $t
    set vTcl(w,opt,-text) $label
}

proc vTcl:set_text {target} {
    global vTcl
    set base .vTcl.[vTcl:rename $target]
    vTcl:text_window $base "Set Text" $target
    tkwait window $base

    ## They closed it without hitting the done button.  Just forget it.
    if {![info exists vTcl(x,$base)]} { return }

    $target configure -text $vTcl(x,$base)
    unset vTcl(x,$base)
    vTcl:create_handles $target
}

proc vTcl:get_text {base text} {
    global vTcl

    ## Remove the last character which is a \n the text widget puts in for
    ## some reason.
    set string [$text get 0.0 end]
    set end [expr [string length $string] - 1]
    set vTcl(x,$base) [string range $string 0 [expr $end - 1]]
    destroy $base
}

proc vTcl:text_window {base title target} {
    global vTcl
    toplevel $base -class Toplevel
    wm transient $base .vTcl
    wm focusmodel $base passive
    wm geometry $base 400x289+[expr $vTcl(mouse,X)-130]+[expr $vTcl(mouse,Y)-20]
    wm maxsize $base 1265 994
    wm minsize $base 1 1
    wm overrideredirect $base 0
    wm resizable $base 1 1
    wm deiconify $base
    wm title $base $title

    ScrolledWindow $base.cpd48
    text $base.cpd48.03 -width 8 -background white
    $base.cpd48 setwidget $base.cpd48.03

    # avoid syntax coloring here (automatic for text widgets in vTcl)
    global $base.cpd48.03.nosyntax
    set $base.cpd48.03.nosyntax 1

    frame $base.butfr

    ::vTcl::OkButton $base.butfr.but52 \
	-command "vTcl:get_text $base $base.cpd48.03"
    vTcl:set_balloon $base.butfr.but52 "Save Changes"

    ::vTcl::CancelButton $base.butfr.but53 -command "destroy $base"
    vTcl:set_balloon $base.butfr.but53 "Discard Changes"

    bind $base <Key-Escape> "$base.butfr.but53 invoke"

    ###################
    # SETTING GEOMETRY
    ###################
    pack $base.butfr -side top -anchor e
    pack $base.butfr.but53 -side right
    pack $base.butfr.but52 -side right
    pack $base.cpd48 -fill both -expand 1
    pack $base.cpd48.03

    $base.cpd48.03 insert end [$target cget -text]
    focus $base.cpd48.03
}

namespace eval ::vTcl::input::lineInput {

proc getLine {title description legend args} {
    set base .vTcl.lineInput
    set top $base
    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm geometry $top 5x5+341+318; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm title $top "$title"
    bindtags $top "$top Toplevel all _TopLevel"
    vTcl:FireEvent $top <<Create>>
    wm transient .vTcl.lineInput .vTcl
    wm protocol $top WM_DELETE_WINDOW "set ::${top}::status cancel"

    bind $top <KeyPress-Return> "set ::${top}::status ok"
    bind $top <KeyPress-Escape> "set ::${top}::status cancel"

    set ::${top}::description $description
    set ::${top}::legend $legend
    set ::${top}::status ""

    label $top.lab80 \
        -anchor w -textvariable "$top\::description" -justify left
    frame $top.fra81 \
        -borderwidth 2 -height 75 -width 125 
    set site_3_0 $top.fra81
    entry $site_3_0.ent83 \
        -background white -textvariable "$top\::entry" 
    vTcl:DefineAlias "$site_3_0.ent83" "LineEntry" vTcl:WidgetProc "$top" 1
    label $site_3_0.lab82 \
        -anchor w -textvariable "$top\::legend" -justify left
    pack $site_3_0.ent83 \
        -in $site_3_0 -anchor center -expand 1 -fill x -padx 5 -pady 5 \
        -side right 
    pack $site_3_0.lab82 \
        -in $site_3_0 -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    frame $top.fra84 \
        -borderwidth 2 -height 75 -width 125 
    set site_3_0 $top.fra84
    button $site_3_0.but85 -command "set ::${top}::status ok" \
        -pady 0 -text OK -width 8 
    button $site_3_0.but86 -command "set ::${top}::status cancel" \
        -pady 0 -text Cancel -width 8 
    pack $site_3_0.but85 \
        -in $site_3_0 -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $site_3_0.but86 \
        -in $site_3_0 -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side right 
    ###################
    # SETTING GEOMETRY
    ###################
    pack $top.lab80 \
        -in $top -anchor center -expand 0 -fill x -padx 5 -pady 5 -side top 
    pack $top.fra81 \
        -in $top -anchor center -expand 0 -fill x -side top 
    pack $top.fra84 \
        -in $top -anchor center -expand 0 -fill none -side top 

    vTcl:FireEvent $base <<Ready>>
    wm deiconify $top
    wm geometry $top {}

    grab set $base
    vwait ::${top}::status
    grab release $base
    if {[set ::${top}::status] == "cancel"} {
        destroy $base
        return ""
    }

    destroy $base
    return [set ::${top}::entry]
}
}; ## namespace eval ::vTcl::input::lineInput

namespace eval ::vTcl::input::listboxSelect {

proc updateSelection {top} {
    upvar ::${top}::selectedItems selectedItems

    set selected [$top.SelectListbox curselection]
    set selectedItems ""

    foreach index $selected {
        lappend selectedItems [$top.SelectListbox get $index]
    }

    if {[lempty $selectedItems]} {
        $top.SelectOK configure -state disabled
    } else {
        $top.SelectOK configure -state normal
    }
}

proc select {contents title {selectMode single} args} {
    set base .vTcl.listboxSelect
    if {[winfo exists $base]} {
        wm deiconify $base; return
    }
    set top $base

    ###################
    # CREATING WIDGETS
    ###################
    vTcl:toplevel $top -class Toplevel
    wm focusmodel $top passive
    wm withdraw $base
    wm geometry $top 339x247+158+260; update
    wm maxsize $top 1284 1006
    wm minsize $top 111 1
    wm overrideredirect $top 0
    wm resizable $top 1 1
    wm title $top $title
    bindtags $top "$top Toplevel all _TopLevel"
    vTcl:FireEvent $top <<Create>>
    wm transient .vTcl.listboxSelect .vTcl
    wm protocol $top WM_DELETE_WINDOW "set ::${top}::status cancel"

    bind $top <KeyPress-Return> "set ::${top}::status ok"
    bind $top <KeyPress-Escape> "set ::${top}::status cancel"

    set ::${top}::listContents $contents
    set ::${top}::status ""
    set ::${top}::selectedItems ""

    frame $top.fra87 \
        -borderwidth 2
    set site_3_0 $top.fra87
    label $site_3_0.lab88 \
        -text {Select item:} -justify left -anchor w
    vTcl:DefineAlias "$site_3_0.lab88" "SelectLabel" vTcl:WidgetProc "$top" 1
    pack $site_3_0.lab88 \
        -in $site_3_0 -anchor center -expand 0 -fill none -side left
    ScrolledWindow $top.fra82 \
        -borderwidth 2 -auto horizontal
    set site_3_0 $top.fra82
    listbox $site_3_0.lis83 \
        -background white -listvariable "::${top}::listContents" \
        -selectmode $selectMode -height 2
    vTcl:DefineAlias "$site_3_0.lis83" "SelectListbox" vTcl:WidgetProc "$top" 1
    $top.fra82 setwidget $site_3_0.lis83
    bind $site_3_0.lis83 <<ListboxSelect>> {
        ::vTcl::input::listboxSelect::updateSelection [winfo toplevel %W]
    }
    frame $top.fra84 \
        -borderwidth 2
    set site_3_0 $top.fra84
    button $site_3_0.but85 -state disabled \
        -pady 0 -text OK -width 8 -command "set ::${top}::status ok" 
    vTcl:DefineAlias "$site_3_0.but85" "SelectOK" vTcl:WidgetProc "$top" 1
    button $site_3_0.but86 \
        -pady 0 -text Cancel -width 8 -command "set ::${top}::status cancel"
    vTcl:DefineAlias "$site_3_0.but86" "SelectCancel" vTcl:WidgetProc "$top" 1
    pack $site_3_0.but85 \
        -in $site_3_0 -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side left 
    pack $site_3_0.but86 \
        -in $site_3_0 -anchor center -expand 0 -fill none -padx 5 -pady 5 \
        -side right 
    ###################
    # SETTING GEOMETRY
    ###################
    pack $top.fra87 \
        -in $top -anchor center -expand 0 -fill x -padx 2 -side top 
    pack $top.fra82 \
        -in $top -anchor center -expand 1 -fill both -side top
    pack $top.fra84 \
        -in $top -anchor center -expand 0 -fill none -side top 

    vTcl:FireEvent $base <<Ready>>
    vTcl:center $base 339 247
    wm deiconify $base

    foreach {option value} $args {
        switch -- $option {
            -oktext {
                 $top.SelectOK configure -text $value
            }
            -canceltext {
                 $top.SelectCancel configure -text $value
            }
            -headertext {
                 $top.SelectLabel configure -text $value
            }
            -selecteditems {
                 set index 0
                 foreach item $contents {
                     set found [lsearch -exact $value $item]
                     if {$found != -1} {
                         $top.SelectListbox selection set $index
                     }
                     incr index
                 }
                 ::vTcl::input::listboxSelect::updateSelection $top
            }
        }
    }

    grab set $base
    vwait ::${top}::status
    grab release $base
    if {[vTcl:at ::${top}::status] == "cancel"} {
        destroy $base
        return ""
    }

    destroy $base
    return [vTcl:at ::${top}::selectedItems]
}
} ; ## namespace eval ::vTcl::input::listboxSelect


