library/text.tcl

   1 # text.tcl --
   2 #
   3 # This file defines the default bindings for text widgets and provides
   4 # procedures that help in implementing the 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 texts.
  15 #-------------------------------------------------------------------------
  16
  17 bind Text <Left> {
  18     ckTextSetCursor %W [%W index {insert - 1c}]
  19 }
  20 bind Text <Right> {
  21     ckTextSetCursor %W [%W index {insert + 1c}]
  22 }
  23 bind Text <Up> {
  24     ckTextSetCursor %W [ckTextUpDownLine %W -1]
  25 }
  26 bind Text <Down> {
  27     ckTextSetCursor %W [ckTextUpDownLine %W 1]
  28 }
  29 bind Text <Prior> {
  30     ckTextSetCursor %W [ckTextScrollPages %W -1]
  31 }
  32 bind Text <Next> {
  33     ckTextSetCursor %W [ckTextScrollPages %W 1]
  34 }
  35 bind Text <Home> {
  36     ckTextSetCursor %W {insert linestart}
  37 }
  38 bind Text <End> {
  39     ckTextSetCursor %W {insert lineend}
  40 }
  41 bind Text <Tab> {
  42     ckTextInsert %W \t
  43     focus %W
  44     break
  45 }
  46 bind Text <Return> {
  47     ckTextInsert %W \n
  48 }
  49 bind Text <Linefeed> {
  50     ckTextInsert %W \n
  51 }
  52 bind Text <Delete> {
  53     if {[%W tag nextrange sel 1.0 end] != ""} {
  54         %W delete sel.first sel.last
  55     } else {
  56         %W delete insert
  57         %W see insert
  58     }
  59 }
  60 bind Text <ASCIIDelete> {
  61     if {[%W tag nextrange sel 1.0 end] != ""} {
  62         %W delete sel.first sel.last
  63     } else {
  64         %W delete insert
  65         %W see insert
  66     }
  67 }
  68 bind Text <BackSpace> {
  69     if {[%W tag nextrange sel 1.0 end] != ""} {
  70         %W delete sel.first sel.last
  71     } elseif [%W compare insert != 1.0] {
  72         %W delete insert-1c
  73         %W see insert
  74     }
  75 }
  76 bind Text <KeyPress> {
  77     ckTextInsert %W %A
  78 }
  79 bind Text <Button-1> {
  80     if [ckFocusOK %W] {
  81         ckTextSetCursor %W @%x,%y
  82         focus %W
  83     }
  84 }
  85
  86 # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  87 # Otherwise, if a widget binding for one of these is defined, the
  88 # <KeyPress> class binding will also fire and insert the character,
  89 # which is wrong.  Ditto for <Escape>.
  90
  91 bind Text <Control> {# nothing}
  92
  93 bind Text <Control-x> {focus [ck_focusNext %W]}
  94
  95 bind Text <Control-a> {
  96     ckTextSetCursor %W {insert linestart}
  97 }
  98 bind Text <Control-b> {
  99     ckTextSetCursor %W insert-1c
 100 }
 101 bind Text <Control-d> {
 102     %W delete insert
 103 }
 104 bind Text <Control-e> {
 105     ckTextSetCursor %W {insert lineend}
 106 }
 107 bind Text <Control-f> {
 108     ckTextSetCursor %W insert+1c
 109 }
 110 bind Text <Control-k> {
 111     if [%W compare insert == {insert lineend}] {
 112         %W delete insert
 113     } else {
 114         %W delete insert {insert lineend}
 115     }
 116 }
 117 bind Text <Control-n> {
 118     ckTextSetCursor %W [ckTextUpDownLine %W 1]
 119 }
 120 bind Text <Control-o> {
 121     %W insert insert \n
 122     %W mark set insert insert-1c
 123 }
 124 bind Text <Control-p> {
 125     ckTextSetCursor %W [ckTextUpDownLine %W -1]
 126 }
 127 bind Text <Control-v> {
 128     ckTextScrollPages %W 1
 129 }
 130 bind Text <Control-h> {
 131     if [%W compare insert != 1.0] {
 132         %W delete insert-1c
 133         %W see insert
 134     }
 135 }
 136 bind Text <FocusIn> {%W see insert}
 137
 138 set ckPriv(prevPos) {}
 139
 140 # ckTextSetCursor
 141 # Move the insertion cursor to a given position in a text.  Also
 142 # clears the selection, if there is one in the text, and makes sure
 143 # that the insertion cursor is visible.  Also, don't let the insertion
 144 # cursor appear on the dummy last line of the text.
 145 #
 146 # Arguments:
 147 # w -           The text window.
 148 # pos -         The desired new position for the cursor in the window.
 149
 150 proc ckTextSetCursor {w pos} {
 151     global ckPriv
 152
 153     if [$w compare $pos == end] {
 154         set pos {end - 1 chars}
 155     }
 156     $w mark set insert $pos
 157     $w tag remove sel 1.0 end
 158     $w see insert
 159 }
 160
 161 # ckTextInsert --
 162 # Insert a string into a text at the point of the insertion cursor.
 163 # If there is a selection in the text, and it covers the point of the
 164 # insertion cursor, then delete the selection before inserting.
 165 #
 166 # Arguments:
 167 # w -           The text window in which to insert the string
 168 # s -           The string to insert (usually just a single character)
 169
 170 proc ckTextInsert {w s} {
 171     if {([string length $s] == 0) || ([$w cget -state] == "disabled")} {
 172         return
 173     }
 174     catch {
 175         if {[$w compare sel.first <= insert]
 176                 && [$w compare sel.last >= insert]} {
 177             $w delete sel.first sel.last
 178         }
 179     }
 180     $w insert insert $s
 181     $w see insert
 182 }
 183
 184 # ckTextUpDownLine --
 185 # Returns the index of the character one line above or below the
 186 # insertion cursor.  There are two tricky things here.  First,
 187 # we want to maintain the original column across repeated operations,
 188 # even though some lines that will get passed through don't have
 189 # enough characters to cover the original column.  Second, don't
 190 # try to scroll past the beginning or end of the text.
 191 #
 192 # Arguments:
 193 # w -           The text window in which the cursor is to move.
 194 # n -           The number of lines to move: -1 for up one line,
 195 #               +1 for down one line.
 196
 197 proc ckTextUpDownLine {w n} {
 198     global ckPriv
 199
 200     set i [$w index insert]
 201     scan $i "%d.%d" line char
 202     if {[string compare $ckPriv(prevPos) $i] != 0} {
 203         set ckPriv(char) $char
 204     }
 205     set new [$w index [expr $line + $n].$ckPriv(char)]
 206     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
 207         set new $i
 208     }
 209     set ckPriv(prevPos) $new
 210     return $new
 211 }
 212
 213 # ckTextScrollPages --
 214 # This is a utility procedure used in bindings for moving up and down
 215 # pages and possibly extending the selection along the way.  It scrolls
 216 # the view in the widget by the number of pages, and it returns the
 217 # index of the character that is at the same position in the new view
 218 # as the insertion cursor used to be in the old view.
 219 #
 220 # Arguments:
 221 # w -           The text window in which the cursor is to move.
 222 # count -       Number of pages forward to scroll;  may be negative
 223 #               to scroll backwards.
 224
 225 proc ckTextScrollPages {w count} {
 226     set bbox [$w bbox insert]
 227     $w yview scroll $count pages
 228     if {$bbox == ""} {
 229         return [$w index @[expr [winfo height $w]/2],0]
 230     }
 231     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
 232 }