Inheriting Widget Binding Classes

Thu Jan 31 12:16:22 MST 2002 - George Peter Staplin: 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 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 [list .t ROText all]
  }
  main

rdt Well first of all, I don't understand why Button-1 is duplicated (ok fixed now), 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 \
     Button-4 Button-5 MouseWheel]

 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

George Peter Staplin: thanks for pointing out the typo :) I removed the duplicate, and made the bindtags into a [list ...]. The problem I see with your solution is that it eliminates some other useful bindings, such as mousewheel, and virtual events that may exist. Although, mine may suffer from other problems that I'm not aware of yet.

rdt Wouldn't the bind:removeAllBut proc have removed them also, before adding back your "keep" list?

rdt What was needed to get the mousewheel to work on my Linux was adding Button-4 and Button-5 and MouseWheel to the keepList.

cjl - As the text widget still allows you to place the cursor and select text, shouldn't '<Copy>' be added to the list of bindings to keep?

Category GUI