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" "$@"
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.tclAnd 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.tclAnd 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" "$@"
# 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