Version 2 of tedit

Updated 2006-09-15 08:22:40 by MJ

MJ - I have just discovered bindtags and what they can do. They allow for some really advanced keyboard handling. An example of this is the base for a Tcl editor below. Keybindings can be associated to certain modes (a la Emacs) This is just a rudimentary basis, but I will expand on this when I have time.

 package require Tk

 namespace eval buffer {
     proc get-point {buffer} {
         return [$buffer index insert]

     proc get-line-with-point {buffer} {
         set point [get-point $buffer]
         set line [$buffer get "$point linestart" "$point lineend"]
         return $line

     # return a list with all bindings on buffer (global and buffer)
     proc list-bindings {buffer} {
         set bindings {} 
         foreach tag [bindtags $buffer] {
             set bindings [concat $bindings [bind $tag]]
         return $bindings

     proc create_new {} {
         text .t
         pack .t -expand 1 -fill both

         # default bindtags for any new buffer
         bindtags .t "fundamental-mode keymap [bindtags .t]"
         return .t

     proc major-mode {buffer mode} {
         bindtags ${buffer} "$mode [lrange [bindtags ${buffer}] 1 end]"
         # call mode-hook here
         wm title . $mode

 namespace eval kb {
     # Stuff to detect key modifiers (taken from

     # array of bit masks to recognize the modifers:
     # - shift - mod5 masks taken from .../tcl/include/X11/X.h
     # - alt mask defined by analysing the status field of Alt-KeyPress
     #   (analysed on MS Windows)
     array set masks [list \
                          shift   [list [expr {1 <<  0}] "Shift"] \
                          lock    [list [expr {1 <<  1}] "Lock"] \
                          control [list [expr {1 <<  2}] "Control"] \
                          mod1    [list [expr {1 <<  3}] "Mod1"] \
                          mod2    [list [expr {1 <<  4}] "Mod2"] \
                          mod3    [list [expr {1 <<  5}] "Mod3"] \
                          mod4    [list [expr {1 <<  6}] "Mod4"] \
                          mod5    [list [expr {1 <<  7}] "Mod5"] \
                          alt     [list [expr {1 << 17}] "Alt"] \

     # MS Windows modifier name map:
     # - Mod1 is identical to "Num"-lock key
     # - Mod3 is identical to "Scroll"-lock key
     set maps [list \
                   "Mod1" "Num" \
                   "Mod3" "Scroll" \

     proc keyModifiers {state {mapToRealName 1}} {
         variable masks;
         variable maps;

         set modifiers [list];

         foreach mask [array names masks] {
             lassign $masks($mask) bits label;

             if {$state & $bits} {
                 lappend modifiers $label;

         set modifiers [join $modifiers "-"];

         if {$mapToRealName == 1} {
             set modifiers [string map $maps $modifiers];

         return $modifiers;

     proc add-binding {tag key proc} {
         set keys [split $key]
         if {[llength $keys] == 1 } {
             # simple keys
             bind $tag ${key} $proc
         } else {
             # create binding for the prefix
             bind $tag "<[lindex $keys 0]>" {event generate .mini <<HandlePrefix>> -data [list %W %s %K]}

             # create binding event for the whole shebang
             bind $tag "<<${key}>>" $proc

     # minibuffer will handle prefixed commands 
     proc handle-prefix-binding {buffer state key} {
         # here the system can collect keybindings until a binding matches
         set prefix "[keyModifiers $state]-$key"
         set all_bindings [::buffer::list-bindings $buffer]

         # add enable minibuffer bindtag
         focus .mini 
         set ::*mini-buffer* {}
         set ::*mini-buffer* "$prefix "

 # scratch mode bindings
 ::kb::add-binding scratch-mode <a> {puts "in scratch mode"; break}
 ::kb::add-binding scratch-mode <Control-j> {puts "should execute [::buffer::get-line-with-point %W]"; break }
 ::kb::add-binding scratch-mode <Control-J> {puts "should execute something now without displaying output" ; break }

 ::kb::add-binding scratch-mode "Control-x Control-b" {puts prefixed}
 ::kb::add-binding scratch-mode "Control-x Control-c" {puts prefixed}

 # global keybindings
 ::kb::add-binding keymap <Control-space> {puts [::buffer::get-point %W]}

 set buff [::buffer::create_new]

 # rudimentary minibuffer. The current state of the minibuffer will be determined by the active bindtags
 entry .mini
 pack .mini -expand 1 -fill x

 .mini configure -textvar *mini-buffer*

 # prefix commands trigger a <<HandlePrefix>> event on the minibuffer with arguments
 # <originating widget> <keystate> <key>

 # also enable minibuffer chording bindtag  
 bind .mini <<HandlePrefix>> {set *mini-buffer* %d ; focus .mini ;  break}

 # also disable minibuffer chording bindtag on Control-g
 bind .mini <Control-g> {focus [lindex [set *mini-buffer*] 0] ; set *mini-buffer* "Aborted" ; break }
 bind .mini <KeyPress> {set *mini-buffer* [list {expand}[set *mini-buffer*] %s %K]}
 .mini configure -state disabled

 ::buffer::major-mode $buff scratch-mode

Category Word and Text Processing