CODEWITHSUNDEEP
tclbind
buzard
buzard

Reputation: 174

tcl/tk widget command and bind mouse button click conflict

I can't get event from a widget stop propagating to parent window. I mean I have a spinbox with its own command, and I got toplevel bind on mouse click to exit the application

spinbox .mask -command { remask this %d ; break }
bind . <ButtonRelease-1> { recopy this ; exit }

When I click on the spinbox scroll button, the application exits all the time. the break doesn't seem to work within spinbox event command.

Also Up and Down key binding don't work also.

Here is the complete code for convenience

proc expand { name } {
    upvar 2 $name what
    uplevel "upvar 1 $name that"
    foreach key [array names what] {
      uplevel "upvar 0 that($key) $key"
    }
}

proc remask { name { delta 0 } } {
  expand $name

  if {$delta == "up"  } { set delta  1 }
  if {$delta == "down"} { set delta -1 }
  set delta [expr $delta < 0 ? -1 : $delta > 0 ? 1 : 0]
  set date [clock add $date $delta $unit]
  set file [clock format $date -format $mask -locale fr]
  set test [file exists $file]
}

proc reunit { name } {
  expand $name

  set map {
    %a days
    %A days
    %d days
    %V weeks
    %b months
    %B months
    %m months
    %y years
    %Y years
    %g years
    %G years
  }

  foreach {key value} $map {
    if { [string first $key $mask] > 0 } {
      set unit $value
      break
    }
  }
}

proc recopy { name } {
    expand $name

    if {!$test} {
        if [file exists $mask] {
            file copy $mask $file
        } else {
            open $file w
        }
    }
}

array set map {
    0   green
    1   red
}

set taken 0
if {$argc > 1} {
  set path [lindex $argv 0]
  cd [file dirname $path]
} else {
  set path "file_%Y%m%d.txt"
}
set this(mask)  [file tail $path]
set this(file)  $this(mask)
set this(date)  [clock seconds]
set this(unit)  days
set this(test)  [file exists $this(file)]

reunit this
remask this

set posx [winfo pointerx .]
set posy [winfo pointery .]
set posx [expr $posx - 50]
set posy [expr $posy - 40]

wm title . "rename $this(mask)"
wm attributes . -toolwindow true
wm geometry . +$posx+$posy

spinbox .mask -textvariable this(file) -foreground $map($this(test)) -command { remask this %d ; break }
pack .mask -fill x -padx 20 -pady 5

grab .
bind . <ButtonRelease-1> { recopy this ; exit }
bind . <Key-Return>      { recopy this ; exit }
bind . <ButtonRelease-3> { exit }
bind . <Key-Escape>      { exit }
bind . <MouseWheel>      { remask this %D ; .mask configure -foreground $map($this(test)) }
bind . <Key-plus>        { remask this +1 ; .mask configure -foreground $map($this(test)) }
bind . <Key-Up>          { remask this +1 ; .mask configure -foreground $map($this(test)) }
bind . <Key-minus>       { remask this -1 ; .mask configure -foreground $map($this(test)) }
bind . <Key-Down>        { remask this -1 ; .mask configure -foreground $map($this(test)) }

Upvotes: 0

Views: 1576

Answers (1)

Donal Fellows
Donal Fellows

Reputation: 137627

The core issue is that break is only magical in a binding script, and not in the -command option script, as that is something that is only invoked indirectly from a binding script (via a class-level binding). That's not about to change. (Also, the -command option also doesn't do %-bind-substitutions normally, though it might substitute; see the widget documentation.)

To prevent that widget from propagating the <ButtonRelease-1> event (and just that event) to the containing toplevel, you need to insert an extra binding tag and apply the binding there.

spinbox .mask -command { remask this %d }
bind . <ButtonRelease-1> { recopy this ; exit }
bindtags .mask {.mask Spinbox extraMagic.mask . all}
bind extraMagic.mask <ButtonRelease-1> break

The binding tag string extraMagic.mask is not special at all except that it is mentioned in both the bind and the bindtags commands. (I put the name of the widget at the end because I'm thinking in terms of having this applied to a single widget only.) What is special is that it comes between Spinbox (the class binding tag) and . (the toplevel binding tag) and that it has a binding for <ButtonRelease-1> which does a break.

Note that this will only apply to events delivered to that specific spinbox; a click on any other widget in the toplevel will make things exit. (It's usually recommended to only put accelerator key-bindings on toplevels, and for user code to avoid attaching to all at all as global bindings are very subtle things that apply in places that it is easy to forget.)

Upvotes: 1

Related Questions