package provide multiEntry 1.0

if { [ catch {package require TclOO } err ] != 0 } {
    puts stderr "Unable to find package TclOO\n$err\nAdjust your auto_path!";
}
oo::class create multiEntry {
    variable win options textvariable opts
    
    constructor { w args } {
        my variable win
        my variable options 
        my variable opts 
        array set options { -yscroll 1 -xscroll 0 -allowtab 0 
       -readonly 0 -textvariable "" }
        array set opts [array get options] 
        set win $w 
        text $win.txt
        grid $win.txt -row 0 -column 0 -sticky nswe
        grid rowconfigure $win 0 -weight 1
        grid columnconfigure $win 0 -weight 1
        my configure {*}$args 
        bind $win <FocusIn> [list focus $win.txt]
    }

    method cget { {opt "" }  } {
        my variable opts
        my variable options
        if { [string length $opt ] } {
            if { ![info exists opts($opt) ] } {
                return [$win.txt cget $opt ]
            }
            return $opts($opt);
        } else {
            return [array get opts ]
        }
    }
    
    method configure { args } {
        my variable opts 
        my variable options
        array set options { -yscroll 1 -xscroll 0 -allowtab 0 -readonly 0 -textvariable "" }
        array set currentopts {}
        array set extraopts {}
        foreach { o def } $args { 
            if { ![info exists options($o) ] } {
                set extraopts($o) $def
            } else {
                set currentopts($o) $def
            }
        }
        if { [info exists currentopts(-yscroll)] } {
            if {$currentopts(-yscroll) == 1} {
                $win.txt configure -yscrollcommand [list $win.vsb set]
                ttk::scrollbar $win.vsb -command [list $win.txt yview]
                grid $win.vsb -row 0 -column 1 -sticky nsw
            } else {
                if { [ winfo exists $win.vsb ] } {
                    grid forget $win.vsb 
                    destroy $win.vsb
                    $win.txt configure -yscrollcommand {}
                }
            }
        }
        if {  [info exists currentopts(-xscroll)] } {
            if {$currentopts(-xscroll) == 1} {
                $win.txt configure -xscrollcommand [list $win.hsb set]
                ttk::scrollbar $win.hsb -orient horizontal -command [list $win.txt xview]
                grid $win.hsb -row 1 -column 0 -sticky we
                $win.txt configure -wrap none
            } else {
                if { [ winfo exists $win.hsb ] } {
                    grid forget $win.hsb 
                    destroy $win.hsb
                    $win.txt configure -xscrollcommand {}
                    $win.txt configure -wrap word
                }
            }
        }
        if { [info exists currentopts(-textvariable)] } {
            set varName $currentopts(-textvariable)
            upvar 2 $varName v
            if { $varName ne [my cget -textvariable ] } { $win.txt delete 1.0 end }
            $win.txt insert 1.0 $v
            $win.txt mark set insert 1.0
            trace add variable v write [list [self] setContent]
            trace add variable v read [list [self] getContent]
        }
        if { [info exists currentopts(-allowtab)] } {
            if {$currentopts(-allowtab) == 0 } {
                bind $win.txt <Shift-Tab> [list [self] focusPrev]
                bind $win.txt <Tab> [list [self] focusNext]
            } else {
                bind $win.txt <Shift-Tab> continue
                bind $win.txt <Tab> continue
            }
        }
        if { [info exists currentopts(-readonly)] } {
            if {$currentopts(-readonly) == 1} {
                # This method prevents keyboard navigation :-/
                bind $win.txt <KeyPress> break
                bind $win.txt <ButtonRelease-2> break
            } else {
                bind $win.txt <KeyPress> continue
                bind $win.txt <ButtonRelease-2> continue
            }
        }
        if { [array size extraopts ] } {
            $win.txt configure {*}[array get extraopts ]
        }
        # save configured opts for cget
        array set opts [array get currentopts ]
     }
    method getTextWidget {} {
        my variable win
        return $win.txt
    }
    
    method focusPrev {} {
        my variable win
        focus [tk_focusPrev $win]
        return -code break
    }

    method focusNext {} {
        my variable win
        focus [tk_focusNext $win.txt]
        return -code break
    }

      method setContent { name element op} {
       upvar 1 $name x
       $win.txt delete 1.0 end
       if { [array exists x ] } {
           $win.txt insert 1.0 $x($element)
       } else {
           $win.txt insert 1.0 $x
       }
   }

   method getContent { name element op } {
       upvar 1 $name x
       if { [array exists x ] } {
           set x($element) [$win.txt get 1.0 "end-1 char"]
       } else {
         set x [$win.txt get 1.0 "end-1 char"]
       }  
   }
}
# Example code 
if { 1 } {
    if { [ catch {package require Tk } err ] != 0 } {
        puts stderr "Unable to find package Tk ... adjust your auto_path!";
    }
    set chuck "You the man"
    frame .frame1
    set a [multiEntry new .frame1 -textvariable chuck -readonly 0 -allowtab 0 \
-yscroll 1 -xscroll 1  -height 3 -width 20 -wrap none]
#    label .frame1.lbl -text "[$a cget]"
    label .lbl -text "[$a cget]"
    frame .bframe
    button .bframe.exit -text Exit -command { exit }
    button .bframe.pub -text Publish -command { puts "chuck = $chuck" }
    label .bframe.lbl -text "Change entry one:"
    entry .bframe.optentry -textvariable ::new_opts 
    button .bframe.setoptsb -text "Set Opts" -command { 
        if { [catch { $a configure {*}$::new_opts } err ] != 0 } {
            tk_messageBox -type ok -icon error -message "$err" 
        } else {
#            .frame1.lbl configure -text [$a cget]
            .lbl configure -text [$a cget]
        }
    }
#    pack .frame1.lbl -side top -fill x
    pack .lbl -side top -fill x
    pack .frame1 -side top -expand 1 -fill both
    pack .bframe.exit -side left -padx 10
    pack .bframe.pub -side left -padx 10
    pack .bframe.lbl -side left -padx 10
    pack .bframe.optentry -side left -padx 10
    pack .bframe.setoptsb -side left -padx 10
    pack .bframe -side top -fill x
}