text.tcl

genesis 2000 v9.1软件下载

# text.tcl --
#
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
# RCS: @(#) $Id: text.tcl,v 1.5 1998/10/10 00:30:36 rjohnson Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

#-------------------------------------------------------------------------
# Elements of tkPriv that are used in this file:
#
# afterId -		If non-null, it means that auto-scanning is underway
#			and it gives the "after" id for the next auto-scan
#			command to be executed.
# char -		Character position on the line;  kept in order
#			to allow moving up or down past short lines while
#			still remembering the desired position.
# mouseMoved -		Non-zero means the mouse has moved a significant
#			amount since the button went down (so, for example,
#			start dragging out a selection).
# prevPos -		Used when moving up or down lines via the keyboard.
#			Keeps track of the previous insert position, so
#			we can distinguish a series of ups and downs, all
#			in a row, from a new up or down.
# selectMode -		The style of selection currently underway:
#			char, word, or line.
# x, y -		Last known mouse coordinates for scanning
#			and auto-scanning.
#-------------------------------------------------------------------------

#-------------------------------------------------------------------------
# The code below creates the default class bindings for entries.
#-------------------------------------------------------------------------

# Standard Motif bindings:

bind Text <1> {
    tkTextButton1 %W %x %y
    %W tag remove sel 0.0 end
}
bind Text <B1-Motion> {
    set tkPriv(x) %x
    set tkPriv(y) %y
    tkTextSelectTo %W %x %y
}
bind Text <Double-1> {
    set tkPriv(selectMode) word
    tkTextSelectTo %W %x %y
    catch {%W mark set insert sel.first}
}
bind Text <Triple-1> {
    set tkPriv(selectMode) line
    tkTextSelectTo %W %x %y
    catch {%W mark set insert sel.first}
}
bind Text <Shift-1> {
    tkTextResetAnchor %W @%x,%y
    set tkPriv(selectMode) char
    tkTextSelectTo %W %x %y
}
bind Text <Double-Shift-1>	{
    set tkPriv(selectMode) word
    tkTextSelectTo %W %x %y
}
bind Text <Triple-Shift-1>	{
    set tkPriv(selectMode) line
    tkTextSelectTo %W %x %y
}
bind Text <B1-Leave> {
    set tkPriv(x) %x
    set tkPriv(y) %y
    tkTextAutoScan %W
}
bind Text <B1-Enter> {
    tkCancelRepeat
}
bind Text <ButtonRelease-1> {
    tkCancelRepeat
}
bind Text <Control-1> {
    %W mark set insert @%x,%y
}
bind Text <Left> {
    tkTextSetCursor %W insert-1c
}
bind Text <Right> {
    tkTextSetCursor %W insert+1c
}
bind Text <Up> {
    tkTextSetCursor %W [tkTextUpDownLine %W -1]
}
bind Text <Down> {
    tkTextSetCursor %W [tkTextUpDownLine %W 1]
}
bind Text <Shift-Left> {
    tkTextKeySelect %W [%W index {insert - 1c}]
}
bind Text <Shift-Right> {
    tkTextKeySelect %W [%W index {insert + 1c}]
}
bind Text <Shift-Up> {
    tkTextKeySelect %W [tkTextUpDownLine %W -1]
}
bind Text <Shift-Down> {
    tkTextKeySelect %W [tkTextUpDownLine %W 1]
}
bind Text <Control-Left> {
    tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind Text <Control-Right> {
    tkTextSetCursor %W [tkTextNextWord %W insert]
}
bind Text <Control-Up> {
    tkTextSetCursor %W [tkTextPrevPara %W insert]
}
bind Text <Control-Down> {
    tkTextSetCursor %W [tkTextNextPara %W insert]
}
bind Text <Shift-Control-Left> {
    tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind Text <Shift-Control-Right> {
    tkTextKeySelect %W [tkTextNextWord %W insert]
}
bind Text <Shift-Control-Up> {
    tkTextKeySelect %W [tkTextPrevPara %W insert]
}
bind Text <Shift-Control-Down> {
    tkTextKeySelect %W [tkTextNextPara %W insert]
}
bind Text <Prior> {
    tkTextSetCursor %W [tkTextScrollPages %W -1]
}
bind Text <Shift-Prior> {
    tkTextKeySelect %W [tkTextScrollPages %W -1]
}
bind Text <Next> {
    tkTextSetCursor %W [tkTextScrollPages %W 1]
}
bind Text <Shift-Next> {
    tkTextKeySelect %W [tkTextScrollPages %W 1]
}
bind Text <Control-Prior> {
    %W xview scroll -1 page
}
bind Text <Control-Next> {
    %W xview scroll 1 page
}

bind Text <Home> {
    tkTextSetCursor %W {insert linestart}
}
bind Text <Shift-Home> {
    tkTextKeySelect %W {insert linestart}
}
bind Text <End> {
    tkTextSetCursor %W {insert lineend}
}
bind Text <Shift-End> {
    tkTextKeySelect %W {insert lineend}
}
bind Text <Control-Home> {
    tkTextSetCursor %W 1.0
}
bind Text <Control-Shift-Home> {
    tkTextKeySelect %W 1.0
}
bind Text <Control-End> {
    tkTextSetCursor %W {end - 1 char}
}
bind Text <Control-Shift-End> {
    tkTextKeySelect %W {end - 1 char}
}

bind Text <Tab> {
    tkTextInsert %W \t
    focus %W
    break
}
bind Text <Shift-Tab> {
    # Needed only to keep <Tab> binding from triggering;  doesn't
    # have to actually do anything.
    break
}
bind Text <Control-Tab> {
    focus [tk_focusNext %W]
}
bind Text <Control-Shift-Tab> {
    focus [tk_focusPrev %W]
}
bind Text <Control-i> {
    tkTextInsert %W \t
}
bind Text <Return> {
    tkTextInsert %W \n
}
bind Text <Delete> {
    if {[%W tag nextrange sel 1.0 end] != ""} {
	%W delete sel.first sel.last
    } else {
	%W delete insert
	%W see insert
    }
}
bind Text <BackSpace> {
    if {[%W tag nextrange sel 1.0 end] != ""} {
	%W delete sel.first sel.last
    } elseif {[%W compare insert != 1.0]} {
	%W delete insert-1c
	%W see insert
    }
}

bind Text <Control-space> {
    %W mark set anchor insert
}
bind Text <Select> {
    %W mark set anchor insert
}
bind Text <Control-Shift-space> {
    set tkPriv(selectMode) char
    tkTextKeyExtend %W insert
}
bind Text <Shift-Select> {
    set tkPriv(selectMode) char
    tkTextKeyExtend %W insert
}
bind Text <Control-slash> {
    %W tag add sel 1.0 end
}
bind Text <Control-backslash> {
    %W tag remove sel 1.0 end
}
bind Text <<Cut>> {
    tk_textCut %W
}
bind Text <<Copy>> {
    tk_textCopy %W
}
bind Text <<Paste>> {
    tk_textPaste %W
}
bind Text <<Clear>> {
    catch {%W delete sel.first sel.last}
}
bind Text <<PasteSelection>> {
    if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
	tkTextPaste %W %x %y
    }
}
bind Text <Insert> {
    catch {tkTextInsert %W [selection get -displayof %W]}
}
bind Text <KeyPress> {
    tkTextInsert %W %A
}

# Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
# Otherwise, if a widget binding for one of these is defined, the
# <KeyPress> class binding will also fire and insert the character,
# which is wrong.  Ditto for <Escape>.

bind Text <Alt-KeyPress> {# nothing }
bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
if {$tcl_platform(platform) == "macintosh"} {
	bind Text <Command-KeyPress> {# nothing}
}

# Additional emacs-like bindings:

bind Text <Control-a> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert linestart}
    }
}
bind Text <Control-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert-1c
    }
}
bind Text <Control-d> {
    if {!$tk_strictMotif} {
	%W delete insert
    }
}
bind Text <Control-e> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W {insert lineend}
    }
}
bind Text <Control-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W insert+1c
    }
}
bind Text <Control-k> {
    if {!$tk_strictMotif} {
	if {[%W compare insert == {insert lineend}]} {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
	}
    }
}
bind Text <Control-n> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W 1]
    }
}
bind Text <Control-o> {
    if {!$tk_strictMotif} {
	%W insert insert \n
	%W mark set insert insert-1c
    }
}
bind Text <Control-p> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextUpDownLine %W -1]
    }
}
bind Text <Control-t> {
    if {!$tk_strictMotif} {
	tkTextTranspose %W
    }
}

if {$tcl_platform(platform) != "windows"} {
bind Text <Control-v> {
    if {!$tk_strictMotif} {
	tkTextScrollPages %W 1
    }
}
}

bind Text <Meta-b> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
    }
}
bind Text <Meta-d> {
    if {!$tk_strictMotif} {
	%W delete insert [tkTextNextWord %W insert]
    }
}
bind Text <Meta-f> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W [tkTextNextWord %W insert]
    }
}
bind Text <Meta-less> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W 1.0
    }
}
bind Text <Meta-greater> {
    if {!$tk_strictMotif} {
	tkTextSetCursor %W end-1c
    }
}
bind Text <Meta-BackSpace> {
    if {!$tk_strictMotif} {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}
bind Text <Meta-Delete> {
    if {!$tk_strictMotif} {
	%W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
    }
}

# Macintosh only bindings:

# if text black & highlight black -> text white, other text the same
if {$tcl_platform(platform) == "macintosh"} {
bind Text <FocusIn> {
    %W tag configure sel -borderwidth 0
    %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
}
bind Text <FocusOut> {
    %W tag configure sel -borderwidth 1
    %W configure -selectbackground white -selectforeground black
}
bind Text <Option-Left> {
    tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind Text <Option-Right> {
    tkTextSetCursor %W [tkTextNextWord %W insert]
}
bind Text <Option-Up> {
    tkTextSetCursor %W [tkTextPrevPara %W insert]
}
bind Text <Option-Down> {
    tkTextSetCursor %W [tkTextNextPara %W insert]
}
bind Text <Shift-Option-Left> {
    tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
}
bind Text <Shift-Option-Right> {
    tkTextKeySelect %W [tkTextNextWord %W insert]
}
bind Text <Shift-Option-Up> {
    tkTextKeySelect %W [tkTextPrevPara %W insert]
}
bind Text <Shift-Option-Down> {
    tkTextKeySelect %W [tkTextNextPara %W insert]
}

# End of Mac only bindings
}

# A few additional bindings of my own.

bind Text <Control-h> {
    if {!$tk_strictMotif} {
	if {[%W compare insert != 1.0]} {
	    %W delete insert-1c
	    %W see insert
	}
    }
}
bind Text <2> {
    if {!$tk_strictMotif} {
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 0
    }
}
bind Text <B2-Motion> {
    if {!$tk_strictMotif} {
	if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
	    set tkPriv(mouseMoved) 1
	}
	if {$tkPriv(mouseMoved)} {
	    %W scan dragto %x %y
	}
    }
}
set tkPriv(prevPos) {}

# The MouseWheel will typically only fire on Windows.  However,
# someone could use the "event generate" command to produce one
# on other platforms.

bind Text <MouseWheel> {
    %W yview scroll [expr - (%D / 120) * 4] units
}

# tkTextClosestGap --
# Given x and y coordinates, this procedure finds the closest boundary
# between characters to the given coordinates and returns the index
# of the character just after the boundary.
#
# Arguments:
# w -		The text window.
# x -		X-coordinate within the window.
# y -		Y-coordinate within the window.

proc tkTextClosestGap {w x y} {
    set pos [$w index @$x,$y]
    set bbox [$w bbox $pos]
    if {![string compare $bbox ""]} {
	return $pos
    }
    if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
	return $pos
    }
    $w index "$pos + 1 char"
}

# tkTextButton1 --
# This procedure is invoked to handle button-1 presses in text
# widgets.  It moves the insertion cursor, sets the selection anchor,
# and claims the input focus.
#
# Arguments:
# w -		The text window in which the button was pressed.
# x -		The x-coordinate of the button press.
# y -		The x-coordinate of the button press.

proc tkTextButton1 {w x y} {
    global tkPriv

    set tkPriv(selectMode) char
    set tkPriv(mouseMoved) 0
    set tkPriv(pressX) $x
    $w mark set insert [tkTextClosestGap $w $x $y]
    $w mark set anchor insert
    if {[$w cget -state] == "normal"} {focus $w}
}

# tkTextSelectTo --
# This procedure is invoked to extend the selection, typically when
# dragging it with the mouse.  Depending on the selection mode (character,
# word, line) it selects in different-sized units.  This procedure
# ignores mouse motions initially until the mouse has moved from
# one character to another or until there have been multiple clicks.
#
# Arguments:
# w -		The text window in which the button was pressed.