library/entry.tcl

   1 # entry.tcl --
   2 #
   3 # This file defines the default bindings for entry widgets and provides
   4 # procedures that help in implementing those bindings.
   5 #
   6 # Copyright (c) 1992-1994 The Regents of the University of California.
   7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
   8 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12
  13 #-------------------------------------------------------------------------
  14 # The code below creates the default class bindings for entries.
  15 #-------------------------------------------------------------------------
  16
  17 bind Entry <Left> {
  18     ckEntrySetCursor %W [expr [%W index insert] - 1]
  19 }
  20 bind Entry <Right> {
  21     ckEntrySetCursor %W [expr [%W index insert] + 1]
  22 }
  23 bind Entry <Home> {
  24     ckEntrySetCursor %W 0
  25 }
  26 bind Entry <End> {
  27     ckEntrySetCursor %W end
  28 }
  29 bind Entry <Delete> {
  30     if [%W selection present] {
  31         %W delete sel.first sel.last
  32     } else {
  33         %W delete insert
  34     }
  35 }
  36 bind Entry <ASCIIDelete> {
  37     if [%W selection present] {
  38         %W delete sel.first sel.last
  39     } else {
  40         %W delete insert
  41     }
  42 }
  43 bind Entry <BackSpace> {
  44     ckEntryBackspace %W
  45 }
  46 bind Entry <Select> {
  47     %W selection from insert
  48 }
  49 bind Entry <KeyPress> {
  50     ckEntryInsert %W %A
  51 }
  52 bind Entry <Control> {# nothing}
  53 bind Entry <Escape> {# nothing}
  54 bind Entry <Return> {# nothing}
  55 bind Entry <Linefeed> {# nothing}
  56 bind Entry <Tab> {# nothing}
  57 bind Entry <BackTab> {# nothing}
  58
  59 bind Entry <Button-1> {
  60     if [ckFocusOK %W] {%W icursor @%x ; focus %W}
  61 }
  62
  63 # Additional emacs-like bindings:
  64
  65 bind Entry <Control-a> {
  66     ckEntrySetCursor %W 0
  67 }
  68 bind Entry <Control-b> {
  69     ckEntrySetCursor %W [expr [%W index insert] - 1]
  70 }
  71 bind Entry <Control-d> {
  72     %W delete insert
  73 }
  74 bind Entry <Control-e> {
  75     ckEntrySetCursor %W end
  76 }
  77 bind Entry <Control-f> {
  78     ckEntrySetCursor %W [expr [%W index insert] + 1]
  79 }
  80 bind Entry <Control-h> {
  81     ckEntryBackspace %W
  82 }
  83 bind Entry <Control-k> {
  84     %W delete insert end
  85 }
  86 bind Entry <Control-t> {
  87     ckEntryTranspose %W
  88 }
  89
  90 # ckEntryKeySelect --
  91 # This procedure is invoked when stroking out selections using the
  92 # keyboard.  It moves the cursor to a new position, then extends
  93 # the selection to that position.
  94 #
  95 # Arguments:
  96 # w -           The entry window.
  97 # new -         A new position for the insertion cursor (the cursor hasn't
  98 #               actually been moved to this position yet).
  99
 100 proc ckEntryKeySelect {w new} {
 101     if ![$w selection present] {
 102         $w selection from insert
 103         $w selection to $new
 104     } else {
 105         $w selection adjust $new
 106     }
 107     $w icursor $new
 108 }
 109
 110 # ckEntryInsert --
 111 # Insert a string into an entry at the point of the insertion cursor.
 112 # If there is a selection in the entry, and it covers the point of the
 113 # insertion cursor, then delete the selection before inserting.
 114 #
 115 # Arguments:
 116 # w -           The entry window in which to insert the string
 117 # s -           The string to insert (usually just a single character)
 118
 119 proc ckEntryInsert {w s} {
 120     if {$s == ""} return
 121     catch {
 122         set insert [$w index insert]
 123         if {([$w index sel.first] <= $insert)
 124                 && ([$w index sel.last] >= $insert)} {
 125             $w delete sel.first sel.last
 126         }
 127     }
 128     $w insert insert $s
 129     ckEntrySeeInsert $w
 130 }
 131
 132 # ckEntryBackspace --
 133 # Backspace over the character just before the insertion cursor.
 134 # If backspacing would move the cursor off the left edge of the
 135 # window, reposition the cursor at about the middle of the window.
 136 #
 137 # Arguments:
 138 # w -           The entry window in which to backspace.
 139
 140 proc ckEntryBackspace w {
 141     if [$w selection present] {
 142         $w delete sel.first sel.last
 143     } else {
 144         set x [expr {[$w index insert] - 1}]
 145         if {$x >= 0} {$w delete $x}
 146         if {[$w index @0] >= [$w index insert]} {
 147             set range [$w xview]
 148             set left [lindex $range 0]
 149             set right [lindex $range 1]
 150             $w xview moveto [expr $left - ($right - $left)/2.0]
 151         }
 152     }
 153 }
 154
 155 # ckEntrySeeInsert --
 156 # Make sure that the insertion cursor is visible in the entry window.
 157 # If not, adjust the view so that it is.
 158 #
 159 # Arguments:
 160 # w -           The entry window.
 161
 162 proc ckEntrySeeInsert w {
 163     set c [$w index insert]
 164     set left [$w index @0]
 165     if {$left > $c} {
 166         $w xview $c
 167         return
 168     }
 169     set x [winfo width $w]
 170     while {([$w index @$x] <= $c) && ($left < $c)} {
 171         incr left
 172         $w xview $left
 173     }
 174 }
 175
 176 # ckEntrySetCursor -
 177 # Move the insertion cursor to a given position in an entry.  Also
 178 # clears the selection, if there is one in the entry, and makes sure
 179 # that the insertion cursor is visible.
 180 #
 181 # Arguments:
 182 # w -           The entry window.
 183 # pos -         The desired new position for the cursor in the window.
 184
 185 proc ckEntrySetCursor {w pos} {
 186     $w icursor $pos
 187     $w selection clear
 188     ckEntrySeeInsert $w
 189 }
 190
 191 # ckEntryTranspose -
 192 # This procedure implements the "transpose" function for entry widgets.
 193 # It tranposes the characters on either side of the insertion cursor,
 194 # unless the cursor is at the end of the line.  In this case it
 195 # transposes the two characters to the left of the cursor.  In either
 196 # case, the cursor ends up to the right of the transposed characters.
 197 #
 198 # Arguments:
 199 # w -           The entry window.
 200
 201 proc ckEntryTranspose w {
 202     set i [$w index insert]
 203     if {$i < [$w index end]} {
 204         incr i
 205     }
 206     set first [expr $i-2]
 207     if {$first < 0} {
 208         return
 209     }
 210     set new [string index [$w get] [expr $i-1]][string index [$w get] $first]
 211     $w delete $first $i
 212     $w insert insert $new
 213     ckEntrySeeInsert $w
 214 }