Undo/Redo Functionality Implementation for GtkTextView Widget Using Gnocl

In many respects the Gtk widget set presents a more powerful set of widgets compared to Tk offerings. The GtkTextView widget, however, has a particularly large gap in its features set, one which used to plague the Tk text widget too, the lack of an undo/redo function. The Gnome GtkSourceView widget does have in-built undo/redo, but this is not unlimited and the sourceView widget was designed for code editing applications, not the editing and display of 'simple text'.

This does not mean that undo/redo functionality cannot be implemented. The 0.9.92 release of Gnocl [L1 ] has extended support for both widget events and signals generated by the GtkTextView widget which enables a reliable undo/redo capability. Here's the code, and the support packages to do the job.


 #---------------
 # UndoRedoDemo.tcl
 #---------------
 # Created by William J Giddings
 # October, 2008
 #---------------
 # Description:
 # Demonstrates simple textBuffer undo/redo functionality.
 #---------------
 # Notes:
 # cd /Desktop/GnoclEdit_2/undoer/wjgstuff
 #
 # This version has a single buffer to show edit history
 #
 #---------------

 # basic Tcl/Gnocl Script
 #! /bin/sh/
 #\
 exec tclsh "$0" "[email protected]"

 package require Gnocl

 source gnoclTextUndoRedo.tcl
 source gnoclBind.tcl

 set text [gnocl::text]
 set box1 [gnocl::box -orientation vertical]
 set box2 [gnocl::box -orientation horizontal ]
 set undo [gnocl::button -text "%#Undo" -onClicked { on_undo $text } ]
 set redo [gnocl::button -text "%#Redo" -onClicked { on_redo $text } ]

 $box2 add [list $undo $redo]
 $box1 add $box2
 $box1 add $text -fill {1 1} -expand 1

 gnocl::window -title "Text" -child $box1

 set userAction 1

 #----------------
 # UNDO/REDO STUFF
 #----------------

 # respond to text insert signals
 $text configure -onInsertText {
        if { $userAction } {
                # add the event details to the undo stack
                push ${text}.UNDO "insert-text \{%r %c\} \{%t\} \{%l\}"
                # clear the redo stack
                catch { unset ${text}.REDO }
        }
 }

 # respond to text insert signals
 $text configure -onDeleteRange {

        if { $userAction } {
                push ${text}.UNDO "delete-range \{%r %c\} \{%l %o\} \{%t\}"
        }
 }

 # respond to text action signals
 $text configure -onBeginUserAction {
        set userAction 1
 }

 $text configure -onEndUserAction {
        set userAction 0
 }

 # there are no default Undo/Redo bindings, so set your own
 # (GtkSourceView widget defaults to Ctrl-z & Ctrl-Z
 gnocl::bind $text <Ctrl-Key-z> "on_undo $text"
 gnocl::bind $text <Ctrl-Key-y> "on_redo $text"

 $text insert end "Ctrl-z undo\nCtrl-y redo"

 #-----------------

 gnocl::mainLoop

 # EOF UndoRedoDemo.tcl

 And now, the support packages:

 #---------------
 # gnoclTextUndoRedo.tcl
 #---------------
 # Created by WIlliam J Giddings
 # 03/08/2008
 #---------------
 # Description:
 # Provide undo/redo functionality for the gnocl text widget.
 #---------------
 # Notes:
 #
 #---------------

 # use arrays to create stacks to contain details of the events
 # this is more effecient than using lists
 # see Welch, Jones & Hobbs pp101

 proc push {stack value} {
        upvar $stack S
        if { ! [info exists S(top)] } {
                set S(top) 0
        }
        set S($S(top)) $value
        incr S(top)
 }

 proc pop { stack } {
        upvar $stack S
        if { ![info exists S(top)] } {
                return {}
        }
        if {$S(top) == 0 } {
                return {}
        } else {
                incr S(top) -1
                set x $S($S(top))
                unset S($S(top))
                return $x
        }
 }

 #
 # UNDO / REDO proceedures
 #

 # Notes:
 # -----
 # Create undo/redo buffers unique to the widget.

 proc on_undo { w } {

        global ${w}.UNDO
        global ${w}.REDO

        if { [array size ${w}.UNDO] == 0 } {
                return
        }
        set action [pop ${w}.UNDO]

        switch [lindex $action 0 ] {
                "insert-text"
                        {
                                # determine the end of range to delete from length of text inserted
                                set col [expr [lindex [lindex $action 1] 1]  +[lindex $action 3] ]
                                set row [lindex [lindex $action 1] 0]
                                $w erase [lindex $action 1] [list $row $col]

                                # resposition the cursor
                                $w setCursor [list $row $col]
                        }
                "delete-range"
                        {
                                # strip leading and trailing braces from the string
                                $w insert [lindex $action 1] [string trim [lindex $action 3] \{\}]

                                # resposition the cursor to the end of the inserted text
                                $w setCursor  [lindex $action 1]
                                $w setCursor cursor+[string length [lindex $action 2]]
                        }
        }
        # display the changes
        $w scrollToPosition cursor
        $w configure -hasFocus 1
        push ${w}.REDO $action
 }

 proc on_redo { w } {

        global ${w}.UNDO
        global ${w}.REDO

        if { [array size ${w}.REDO] == 0 } {
                return
        }
        set action [pop ${w}.REDO]
        switch [lindex $action 0 ] {
                "insert-text"
                        {

                                # determine the end of range to delete from length of text inserted
                                # The text is returned as a list, so if there is purely whitespace this
                                # will re mis-read as a sub-list by the interpreter.
                                # So, get the text as the first item to prevent this.
                                $w insert [lindex $action 1] [lindex [lindex $action 2] 0]

                            # resposition the cursor to the end of the inserted text
                                $w setCursor  [lindex $action 1]
                                $w setCursor cursor+[string length [lindex $action 2]]
                        }
                "delete-range"
                        {

                                # determine the end of range to delete from length of text inserted
                                set col [expr [lindex [lindex $action 1] 1]  +[lindex $action 3] ]
                                set row [lindex [lindex $action 1] 0]
                                $w erase [lindex $action 1] [list $row $col]

                                # resposition the cursor
                                $w setCursor [list $row $col]
                        }
        }

        # display the changes
        $w scrollToPosition cursor
        $w configure -hasFocus 1
        push ${w}.UNDO $action

 }

 # EOF gnoclTextUndoRedo.tcl

And now for the binding code.


 #---------------
 # gnocl::bind.tcl
 #---------------
 # This file adds keysequence bindings to a gnocl widget
 #
 # Author: William J Giddings, 13-Sept-2007
 #---------------

 # basic Tcl/Gnocl Script
 #!/bin/sh/
 #\
 exec tclsh "$0" "[email protected]"

 # Modifier Bitmask Values
 #
 #        0   | no modifiers
 #        1   | Shift
 #        2   | Caps_Lock on
 #        4        | Control_L/R
 #        8        | Alt_L/R
 #        16        | Num_Lock (on)
 #        32        | ?
 #        64        | Super_L/R
 #        128 | alt-gr

 # I've seen these values appear, but..
 #  256  | Button-1
 #  512  | Button-2

 # package require Gnocl

 #---------------
 # As I like real-words rather than deniary
 #---------------
 proc kb_modifiers {v} {

   set state 0
   set flags {
      Shift       1
      Caps_Lock   2
      Ctrl        4
      Alt         8
      Num_Lock    16
      Super       64
      Alt-Gr      128
      Button_1    256
      Button_2    512
      }
   foreach {a b} $flags {
      if {$v & $b } {lappend state $a}
   }
   return $state
 }

 #---------------
 # create binding handler
 #---------------
 proc gnocl::keyBindingHandler {w s K} {

   # remove Num_Lock On event bitmask
   set event [lindex $s 0]
   if {16 & $event} { set event [expr 16 ^ $event ] }
   set s [lreplace $s 0 0 $event]

   # check for Shift, if a single letter, restore to lowercase
   if {1 & $event && [string length $K] == "1"} { set K [string tolower $K] }
   set events [array names ::keyBindings]

   # sorry, not the best practice to error trap with catch, but its the easiest!
   catch { eval $::keyBindings($s,$K) }

 }

 #---------------
 # create binding handler
 #---------------
 proc gnocl::buttonBindingHandler { w s b x y} {

   # remove Num_Lock On event bitmask
   set event [lindex $s 0]
   if {16 & $event} { set event [expr 16 ^ $event ] }
   set s [lreplace $s 0 0 $event]

   # execute binding
   catch {
      # save current pointer coordinate of last click
      set ::gnocl::x $x
      set ::gnocl::y $y
      eval [ set ${w}.buttonBindings($s,Button$b) ]
      }

 }

 #---------------
 # assign bindings to (text) widget
 # concatenate these bindings with others which may have been assigned to events
 #---------------
 proc gnocl::bind {widget event script} {

        # what are the existing bindings?

        # cget not yet implemented
        # puts "keyPress [$widget cget -onKeyPress]"
        # puts "buttonPress [$widget cget -onButtonPress]"

        set event [string trimleft $event "<"]
        set event [string trimright $event ">" ]
        set tmp "-"
        regsub -all -- - $event " " event

        # parse event and create BITMASK
        set bitMask 0
        foreach {eventType bitVal} {
                Shift       1
                Ctrl        4
                Alt         8
                } {
                        if { [string first $eventType $event] != -1 } {
                                set bitMask [expr $bitMask + $bitVal]
                                }
                        }

   if { [string first Key $event] != -1 } {

      # add to the list of Key events
      set ::keyBindings($bitMask,[lindex $event end]) $script

   } elseif { [string first Button $event] !=-1 } {

      # add to the list of Button Events
      set ${widget}.buttonBindings($bitMask,[lindex $event end]) $script

   }

   # attach bindings
   $widget configure -onKeyPress { gnocl::keyBindingHandler %w %s %K }
   $widget configure -onButtonPress { gnocl::buttonBindingHandler %w %s %b %x %y }

 }

 #----- DEMO CODE -----
 proc bind:demo {} {

   set txt [gnocl::text]

   gnocl::window \
          -child $txt \
          -title "GNOCL Text Bindings" \
          -visible 1 \
          -width 250 \
          -height 120 \
          -onDestroy {exit}

   $txt insert end TEST

   # Add some bindings, some of these will conflict with GTK defaults
   # These bindings do not replace the defaults as in TK

   gnocl::bind $txt <Shift-Key-a> {puts "Say 'Shift-a'"}
   gnocl::bind $txt <Alt-Key-A> {puts "Say 'Alt-a'"}
   gnocl::bind $txt <Alt-Key-a> {puts "Say 'Alt-a'"}
   gnocl::bind $txt <Ctrl-Key-a> {puts "Say 'Ctrl-a'"}
   gnocl::bind $txt <Shift-Alt-Key-a> {puts "Say 'Shift-Alt-a'"}
   gnocl::bind $txt <Shift-Ctrl-Key-a> {puts "Say 'Shift-Ctrl-a'"}
   gnocl::bind $txt <Shift-Alt-Ctrl-Key-a> {puts "Say 'Shift-Alt-Ctrl-a'"}

   gnocl::bind $txt <Ctrl-Key-F1> {puts "Ctrl F1"}
   gnocl::bind $txt <Shift-Key-F1> {puts "Shift F1"}
   gnocl::bind $txt <Key-F2> {puts "F2"}

   gnocl::bind $txt <Alt-Button1> {puts "Alt Button1!"}
   gnocl::bind $txt <Ctrl-Button1> {puts "Ctrl Button1!"}
   gnocl::bind $txt <Shift-Button1> {puts "Shift Button1! $::gnocl::x $::gnocl::y"}

   gnocl::bind $txt <Alt-Button2> {puts "Alt Button2!"}
   gnocl::bind $txt <Ctrl-Button2> {puts "Ctrl Button2!"}
   gnocl::bind $txt <Shift-Button2> {puts "Shift Button2!"}

   gnocl::bind $txt <Ctrl-Key-z> {puts "UNDO!"}
   gnocl::bind $txt <Shift-Ctrl-Key-z> {puts "REDO!"}

 }

 # EOF gnocl::bind.tcl