Version 3 of widget:entry

Updated 2002-08-07 09:41:59

GPS May 27, 2002: I wanted an extended entry box that provides by default copy, paste, cut, and append options via a popup menu. I also wanted the ability to restrict the data entered to a RE pattern. The solution below provides a modified entry widget that does all of the above. It is standalone, but does use one of the binding procs from the Inheriting Widget Binding Classes page.

---

#Updated Aug 7, 2002 to fix minor bugs and introduce paste primary

proc widget:entry:copy {win type} {

        if {[$win index end] == 0 || [catch {$win index sel.first}]} {
                return
        }

        if {[catch {selection get -displayof $win -selection $type -type STRING} data]} {
                return
        }
        clipboard clear -displayof $win
        clipboard append -displayof $win $data

}

proc widget:entry:paste {win type} {

        if {[catch {selection get -displayof $win -selection $type -type STRING} data]} {
                return
        }
        $win insert insert $data

}

proc widget:entry:cut {win type} {

        if {[catch {$win index sel.first}]} {
                return
        }

        if {[catch {selection get -displayof $win -selection $type -type STRING} data]} {
                return
        }
        $win delete sel.first sel.last
        clipboard clear -displayof $win
        clipboard append -displayof $win $data

}

proc widget:entry:append {win type} {

        if {[$win index end] == 0 || [catch {$win index sel.first}]} {
                return
        }

        if {[catch {selection get -displayof $win -selection $type -type STRING} data]} {
                return
        }
        clipboard append -displayof $win $data

}

proc widget:entry:clear {win} {

        $win delete 0 end

}

proc widget:entry:event:ButtonPress-3 {win X Y} {

        destroy $win._popup
        set m [menu $win._popup -tearoff 0]

        #valid types are PRIMARY and CLIPBOARD

        $m add command -label Copy -command "widget:entry:copy $win PRIMARY"
        $m add command -label "Paste Primary" -command "widget:entry:paste $win PRIMARY"
        $m add command -label "Paste Clipboard" -command "widget:entry:paste $win CLIPBOARD"
        $m add command -label Cut -command "widget:entry:cut $win PRIMARY"
        $m add command -label Append -command "widget:entry:append $win PRIMARY"
        $m add command -label Clear -command "widget:entry:clear $win"

        tk_popup $m $X $Y

}

proc widget:entry:instanceCmd {win args} {

        upvar #0 widget:entry$win inputRegexp
        set cmd [lindex $args 0]
        set useInputRegexp 0
        set isInsert 0

        if {[string length $inputRegexp] > 0} {
                set useInputRegexp 1
        }

        if {[string equal $cmd "insert"]} {
                set isInsert 1
        }

        if {$isInsert && $useInputRegexp} {
                set data [lrange $args 2 end]

                set valid 1
                foreach char [split $data ""] {
                        if {[regexp $inputRegexp $char] <= 0} {
                                set valid 0
                                break
                        }
                }
                if {$valid} {
                        return [uplevel 2 widget:entry:origCmd$win $args]
                }
        } else {
                return [uplevel 2 widget:entry:origCmd$win $args]
        }

}

proc widget:entry {win args} {

        upvar #0 widget:entry$win inputRegexp
        set inputRegexp ""

        if {[set pos [lsearch $args "-inputregexp"]] > -1} {
                set posRe [expr {$pos + 1}]
                set inputRegexp [lindex $args $posRe]
                set args [lreplace $args $pos $posRe]
        }

        eval entry [concat $win $args] 

        bind:copyClass Entry Widget:Entry

        bind Widget:Entry <ButtonPress-3> {widget:entry:event:ButtonPress-3 %W %X %Y}

        #use our new binding class
        bindtags $win "$win Widget:Entry all"

        rename $win widget:entry:origCmd$win
        proc $win {args} "eval widget:entry:instanceCmd $win \$args"

        return $win

}

---

  #BEGIN test code
  proc checkIP {win clientData} {
    set RE {[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}}

    set data [$win get]

    set result 1
    if {[regexp $RE $data] > 0} {
      foreach num [split $data .] {
        if {$num < 0 || $num > 255} {
          set result 0
          break
        }
      }
    } else {
      set result 0
    }

    eval [concat $clientData $result]
  }

  proc main {} {
    pack [widget:entry .e -inputregexp {[0-9\.]} -width 20]
    .e insert end abc ;#should fail
    pack [frame .info] -side left -fill x
    pack [label .info.valid -text "Valid: "] -side left
    pack [label .info.bool -text 0] -side left
    #I could use a textvariable but this works
    pack [button .checkIP -text "Check IP" -command "checkIP .e {.info.bool config -text}"]
    pack [button .exit -text Exit -command exit]
  }
  main

---