Version 7 of Inheriting Widget Binding Classes

Updated 2005-03-05 20:30:56 by rdt

Thu Jan 31 12:16:22 MST 2002 - GPS: I looked at the various ways in which people modify bindings to make a read only text widget and came up with the code below. The nice thing about this vs. the Read-only text widget page is that it doesn't require a modified file -- it does it all in memory.


  #!/bin/wish8.3

  proc copyBindingClass {class newClass} {
    set bindingList [bind $class]
    foreach binding $bindingList {
      bind $newClass $binding [bind $class $binding]
    }
  }

  proc removeBindingsFromClass {class removeList} {
    foreach item $removeList {
      bind $class <$item> {}
    }
  }

  pack [text .t]
  .t insert end "Hello World"

  copyBindingClass Text Text.t

  bindtags .t ".t Text.t all"

  removeBindingsFromClass Text.t [list KeyPress Delete BackSpace Meta-Key-Delete \
 Key-Tab Key-Insert Key-Left Key-Right Key-Up Key-Down Shift-Key-Left \
 Shift-Key-Right Shift-Key-Up Shift-Key-Down Control-Key-Left Control-Key-Right \
 Control-Key-Up Control-Key-Down Control-Shift-Key-Left Control-Shift-Key-Right \
 Key-Return Key-BackSpace Control-Key-space Control-Shift-Key-space \
 Shift-Key-Select <Paste> <Cut> <Clear>]

BBH 8Feb2002 - I like this approach (saves the extra file) - here is a variant that I created so I don't have to list out all the bindings that alter a text widget - just examine the bindings themselves!

 # generate bindings for ROText based on Text bindings
 # this exp finds anything that modifies a text widget contents
 set exp  {(%W (insert|delete))|((tkText|tk_text)(Insert|Paste|Cut))}
 foreach ev [bind Text] {
     set body [bind Text $ev]
     if {![regexp $exp $body]} {
         bind ROText $ev $body
     }
 }
 # define new proc for creating read only text widgets
 proc rotext {args} {
     set w [eval [linsert $args 0 text]]
     bindtags $w "$w ROText [winfo toplevel $w] all"
     return $w
 }

GPS Sat Feb 9 2002 - I'm glad you like it. Here's an updated version with several improvements:

  proc bind:copyClass {class newClass} {
    set bindingList [bind $class]
    #puts $bindingList

    foreach binding $bindingList {
      bind $newClass $binding [bind $class $binding]
    }
  }

  proc bind:removeAllBut {class bindList} {
    foreach binding $bindList {
      array set tmprab "<${binding}> 0"
    }

    foreach binding [bind $class] {
      if {[info exists tmprab($binding)]} {
        continue
      }
      bind $class $binding {}
    }
  }

  proc main {} {
    pack [text .t]
    .t insert end "Hello World"

    bind:copyClass Text ROText
    bind:removeAllBut ROText [list Button-1 Button-1 B1-Motion Double-Button-1 Tripple-Button-1 Shift-Button-1 Double-Shift-Button-1 Triple-Shift-Button-1 Button-2 B2-Motion B1-Leave]

    bindtags .t ".t ROText all"
  }
  main

rdt Well first of all, I don't understand why Button-1 is duplicated, but for Read-only text, isn't this just:

 set keepList [list Button-1 B1-Motion Double-Button-1 \
     Tripple-Button-1 Shift-Button-1 Double-Shift-Button-1 \
     Triple-Shift-Button-1 Button-2 B2-Motion B1-Leave]

 proc roClass {oldClass newClass keepList} {
   foreach binding $keepList {
     array set tmp "<${binding}> 0"
   }
   foreach binding [bind $oldClass] {
     if {[info exists tmp($binding)]} {
       bind $newClass $binding [bind $oldClass $binding]
     }
   }
 }

 proc main {} {
   global keepList
   pack [text .t]
   .t insert end "Hello World"
   roClass Text Disp $keepList
   bindtags .t ".t Disp all"
 }

 main

Category GUI