#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Entry.tcl,v $
# $Date: 2000/01/17 12:31:14 $
# $Revision: 1.18.1.11 $
#
package provide zircon 1.18
#
# Make an entry with some emacs-like edit keys......
#
proc emacsInsertSelect {ent} {
    if {[normal $ent] && ![catch {selection get} bf] && \
	![string match {} $bf]} {
	$ent insert insert $bf
	tkEntrySeeInsert $ent
    }
}
#
proc emacsTInsertSelect {ent} {
    if {[normal $ent] && ![catch {selection get} bf] && \
	![string match {} $bf]} {
	$ent insert insert $bf	
	$ent see insert
    }
}
#
proc entryBindings {} {
    global zircon
#   bind EmacsEntry <ButtonRelease-2> {notIdle %W ; emacsInsertSelect %W ; break}
    bind EmacsEntry <Delete> {notIdle %W ; tkEntryBackspace %W ; break}
    bind EmacsEntry <Control-u> {notIdle %W ; %W delete 0 insert }
    bind EmacsEntry <$zircon(meta)-b> {notIdle %W ; tkEntryInsert %W \002 ; %W icursor insert}
    bind EmacsEntry <$zircon(meta)-o> {notIdle %W ; tkEntryInsert %W \017}
    bind EmacsEntry <$zircon(meta)-u> {notIdle %W ; tkEntryInsert %W \037}
    bind EmacsEntry <$zircon(meta)-v> {notIdle %W ; tkEntryInsert %W \026}
}
#
proc emacsEntry {name args} {
    eval entry $name -relief sunken $args
    switch {} [bind EmacsEntry] {entryBindings}
    bindtags $name "$name EmacsEntry Entry . all"
    return $name
}
#
proc emacsTEntry {name args} {
    global zircon
    eval text $name -relief sunken -height 1 -wrap none -setgrid 0 $args
    bind $name <ButtonRelease-2> {notIdle %W ; emacsTInsertSelect %W ; break}
    bind $name <Control-u> {notIdle %W ; %W delete 1.0 insert }
    bind $name <Delete> "[bind Text <BackSpace>] ; break"
    bind $name <$zircon(meta)-b> {notIdle %W ; tkEntryInsert %W \002 ; %W icursor insert}
    bind $name <$zircon(meta)-o> {notIdle %W ; %W insert insert \017}
    bind $name <$zircon(meta)-u> {notIdle %W ; %W insert insert \037}
    bind $name <$zircon(meta)-v> {notIdle %W ; %W insert insert \026}
    return $name
}
#
proc entrySet {win val} {
    $win conf -state normal
    $win delete 0 end
    $win insert end $val
}
#
proc labelEntry {t name opts init code} {
    frame $name
    eval label $name.label $opts
    [expr {$t ? "emacsTEntry" : "emacsEntry"}] $name.entry -relief sunken
    $name.entry insert end $init
    grid columnconfigure $name 1 -weight 1
    grid $name.label -sticky w
    grid $name.entry -row 0 -column 1 -sticky ew
    bind $name.entry <Return> "notIdle %W ; $code"
    bind $name.entry <BackSpace> [bind $name.entry <Delete>]
    bind $name.entry <Control-h> [bind $name.entry <Delete>]
    return $name
}
#
proc glabelEntry {t row col name opts init code} {
    eval label $name.l$row $opts
    [expr {$t ? "emacsTEntry" : "emacsEntry"}] $name.e$row -relief sunken
    $name.e$row insert end $init
    grid $name.l$row -row $row -column $col
    grid $name.e$row -row $row -column [expr {$col + 1}]
    bind $name.e$row <Return> "notIdle %W ; $code"
    bind $name.e$row <BackSpace> [bind $name.e$row <Delete>]
    bind $name.e$row <Control-h> [bind $name.e$row <Delete>]
    return $name
}
#
proc labelNumber {t name opts init code} {
    labelEntry $t $name $opts $init $code
    bindtags $name.entry "$name.entry NEntry"
    return $name
}
