text.tcl

This Source-Navigator, an IDE for C/C++/Fortran/Java/Tcl/PHP/Python and a host of other languages.

# Copyright (c) 2000, Red Hat, Inc.
# 
# This file is part of Source-Navigator.
# 
# Source-Navigator is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2, or (at your option)
# any later version.
# 
# Source-Navigator is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
# 
# You should have received a copy of the GNU General Public License along
# with Source-Navigator; see the file COPYING.  If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
# 
# text.tcl
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# This file defines the default bindings for Tk text widgets and is a
# highly extended version of the original distributed with Tk4.0. It
# is intended as a drop in replacement for the original. If you do not
# have the permission or desire to do that, then you run the following
# lines in your applicaiton to achieve the efficitively same result
#
# foreach key [bind Text] { bind Text $key {} }
# source text.tcl
#
# This is beta software so beware. It will work only with Tk4.0.
# Release tkBindExtended

# ORIGINAL COPYRIGHT INFORMATION
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# ADDITIONAL COPYRIGHT INFORMATION
#
# Copyright 1995 by Paul Raines (raines&slac.stanford.edu)
# with the same DISCLAIMER as above 

#-------------------------------------------------------------------------
# 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.
# mouseMoved -		Non-zero means the mouse has moved a significant
#			amount since the button went down (so, for example,
#			start dragging out a selection).
# selectMode -		The style of selection currently underway:
#			char, word, or line.
# x, y -		Last known mouse coordinates for scanning
#			and auto-scanning.
#-------------------------------------------------------------------------
global tkPriv

#-------------------------------------------------------------------------
# Elements of tkBind used by all text widgets.
#
# fillCol -		Default fill column for initializing text widgets
#-------------------------------------------------------------------------
global tkBind

tkBindDefVar fillCol 0

#-------------------------------------------------------------------------
# Elements of tkText specific to each text widget
#
# char -		Character position on the line; kept in order
#			to allow moving up or down past short lines while
#			still remembering the desired position.
# 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.
# arg -			current argument count for repeating next command
# prevCmd -		The last tkText command run
# markActive -		Whether transient mark mode is active
# ovwrt - 		Whether overwrite mode is active
# killLast -		Text index of last kill used to determine whether
#			the next kill can be appended to the last kill
# undoList -		List storing undo info for each step
# undoCnt - 		Length of the undo list
# undoCut -		Info of last operation that can be undone
# undoFirst - 		Starting text index of last undoable operation
# undoLast - 		Ending text index of last undoable operation
# markRing -		List as history of emacs marks in buffer
# fillCol -		Character column at which to "hard" wrap text
# fillWidth -		Best guess at pixel width to wrap lines at
#-------------------------------------------------------------------------
global tkText

# tkTextSetup --
# Set up private variables for the specified text widget 'w'.

proc tkTextSetup w {
    global tkText tkBind

    if [info exists tkText(${w},char)] return

    set tkText(${w},char) {}
    set tkText(${w},prevPos) {}
    set tkText(${w},prevCmd) Setup
    set tkText(${w},markActive) 0
    set tkText(${w},ovwrt) 0
    set tkText(${w},killLast) 0.0
    set tkText(${w},markRing) {}
    set tkText(${w},fillCol) $tkBind(fillCol)
    set tkText(${w},fillWidth) [tkTextGetFillWidth ${w} $tkText(${w},fillCol)]

    set tkBind(${w},bindtags) {}
    set tkBind(${w},arg) {}
    set tkBind(${w},toplevel) [winfo toplevel ${w}]

    tkBindDefVar "${w},mesg" {}

    if $tkBind(bindUndo) {
        tkTextUndoSetup ${w}
    }

    if {[info proc tkTextWidgetHook]!=""} {
        tkTextWidgetHook ${w}
    }
    ${w} mark set emacs 0.0
}

# tkTextDestroy --
# Free memory of private variables for the specified text widget 'w'.

proc tkTextDestroy w {
    global tkText tkBind

    catch {unset tkText(${w},char)}
    catch {unset tkText(${w},prevPos)}
    catch {unset tkText(${w},prevCmd)}
    catch {unset tkText(${w},markActive)}
    catch {unset tkText(${w},ovwrt)}
    catch {unset tkText(${w},killLast)}
    catch {unset tkText(${w},markRing)}
    catch {unset tkText(${w},fillCol)}
    catch {unset tkText(${w},fillWidth)}

    catch {unset tkBind(${w},bindtags)}
    catch {unset tkBind(${w},mesg)}
    catch {unset tkBind(${w},arg)}

    catch {tkTextUndoFree ${w}}
}

# Setup/Cleanup bindings
bind Text <FocusIn> {tkTextSetup %W}
bind Text <Destroy> {tkTextDestroy %W}

# Mouse bindings

bind Text <Button> {
	if {!(%b == 1 || %b == 3)} break
	tkTextButton%b %W %x %y
	%W tag remove sel 0.0 end
	set tkPriv(x) %x
	set tkPriv(y) %y
}
bind Text <B1-Motion> {
	set tkPriv(x) %x
	set tkPriv(y) %y
	tkTextSelectTo %W %x %y
}
bind Text <B3-Motion> {
	set tkPriv(x) %x
	set tkPriv(y) %y
	tkTextSelectTo %W %x %y
}
bind Text <Double-Button> {
	if {!(%b == 1 || %b == 3)} break
	set tkPriv(selectMode) word
	tkTextSelectTo %W %x %y
# if {%b == 1} { catch {%W mark set insert sel.first} }
}
bind Text <Triple-Button> {
	if {!(%b == 1 || %b == 3)} break
	set tkPriv(selectMode) line
	tkTextSelectTo %W %x %y
	if {%b == 1} { catch {%W mark set insert sel.first} }
}
bind Text <Shift-Button> {
	if {!(%b == 1 || %b == 3)} break
	tkTextResetAnchor %W @%x,%y
	set tkPriv(selectMode) char
	tkTextSelectTo %W %x %y
}
bind Text <Double-Shift-Button> {
	if {!(%b == 1 || %b == 3)} break
	set tkPriv(selectMode) word
	tkTextSelectTo %W %x %y
}
bind Text <Triple-Shift-Button> {
	if {!(%b == 1 || %b == 3)} break
	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 <B3-Leave> {
}
bind Text <B3-Enter> {
}
bind Text <ButtonRelease> {
	if {!(%b == 1 || %b == 3)} break
	tkCancelRepeat
	if {[selection own -displayof %W] == "%W" &&
			[string length [%W tag nextrange sel 1.0 end]]} {
#		clipboard clear -displayof %W
#		clipboard append -displayof %W [selection get -displayof %W]
	}
}
bind Text <Control-1> {
	%W mark set insert @%x,%y
}

bind Text <3> {
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 1
}

bind Text <B3-Motion> {
	%W scan dragto %x %y
}

bind Text <B2-Motion> { }

bind Text <2> {
	%W mark set insert @%x,%y
	%W scan mark %x %y
	set tkPriv(x) %x
	set tkPriv(y) %y
	set tkPriv(mouseMoved) 1
}

bind Text <ButtonRelease-2> {
	tkTextSetup %W
	tkTextButtonInsert %W %x %y
	focus %W;		# Very important for Undo support.
}

# Standard key bindings

bind Text <Left> {
	tkTextSetCursor %W [tkTextPlaceChar %W -]
}
bind Text <Right> {
	tkTextSetCursor %W [tkTextPlaceChar %W +]
}
bind Text <Up> {
	set pos [tkTextPlaceLine %W -]
	tkTextSetCursor %W $pos
	set tkText(%W,prevPos) $pos
}
bind Text <Down> {
	set pos [tkTextPlaceLine %W +]
	tkTextSetCursor %W $pos
	set tkText(%W,prevPos) $pos
}
bind Text <Shift-Left> {
	tkTextKeySelect %W [tkTextPlaceChar %W -]
}
bind Text <Shift-Right> {
	tkTextKeySelect %W [tkTextPlaceChar %W +]
}
bind Text <Shift-Up> {
	set pos [tkTextPlaceLine %W -]
	tkTextKeySelect %W $pos
	set tkText(%W,prevPos) $pos
}
bind Text <Shift-Down> {
	set pos [tkTextPlaceLine %W +]
	tkTextKeySelect %W $pos
	set tkText(%W,prevPos) $pos
}
bind Text <Control-KeyPress> { }
bind Text <Control-Left> {
	tkTextSetCursor %W [tkTextPlaceWord %W -]
}
bind Text <Control-Right> {
	tkTextSetCursor %W [tkTextPlaceWord %W +]
}
bind Text <Control-Up> {
	tkTextSetCursor %W [tkTextPlacePara %W -]
}
bind Text <Control-Down> {
	tkTextSetCursor %W [tkTextPlacePara %W +]
}
bind Text <Shift-Control-Left> {
	tkTextKeySelect %W [tkTextPlaceWord %W -]
}
bind Text <Shift-Control-Right> {
	tkTextKeySelect %W [tkTextPlaceWord %W +]
}
bind Text <Shift-Control-Up> {
	tkTextKeySelect %W [tkTextPlacePara %W -]
}
bind Text <Shift-Control-Down> {
	tkTextKeySelect %W [tkTextPlacePara %W +]
}
bind Text <Prior> {
	tkTextSetCursor %W [tkTextScrollPages %W -]
}
bind Text <Shift-Prior> {
	tkTextKeySelect %W [tkTextScrollPages %W -]
}
bind Text <Next> {
	tkTextSetCursor %W [tkTextScrollPages %W +]
}
bind Text <Shift-Next> {
	tkTextKeySelect %W [tkTextScrollPages %W +]
}
bind Text <Control-Prior> {
	%W xview scroll [tkBindDefArg %W -] page
}
bind Text <Control-Next> {
	%W xview scroll [tkBindDefArg %W +] page
}

bind Text <Home> {
	tkTextSetCursor %W [tkTextPlaceHome %W +]
}
bind Text <Shift-Home> {
	tkTextKeySelect %W [tkTextPlaceHome %W +]
}
bind Text <End> {
	tkTextSetCursor %W [tkTextPlaceEnd %W +]
}
bind Text <Shift-End> {
	tkTextKeySelect %W [tkTextPlaceEnd %W +]
}
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> {
	tkTextInsertChar %W \t
	focus %W
	break
}
bind Text <Shift-Tab> {
	# Needed only to keep <Tab> binding from triggering; doesn't
	# have to actually do anything.
}
bind Text <Control-Tab> {
	focus [tk_focusNext %W]
}
bind Text <Control-Shift-Tab> {
	focus [tk_focusPrev %W]
}
bind Text <Control-i> {
	tkTextInsertChar %W \t
}
bind Text <Return> {
	tkTextInsertChar %W \n
	set tkText(%W,prevCmd) NewLine
}

catch {
    bind Text <apLineDel> {
		tkTextDelete %W insert [tkTextPlaceChar %W +] $tkBind(delSel) 0
	}
}

bind Text <Delete> {
	tkTextDelete %W insert [tkTextPlaceChar %W +] $tkBind(delSel) 0
}
bind Text <BackSpace> {
	tkTextDelete %W insert [tkTextPlaceChar %W -] $tkBind(delSel) 0
}

bind Text <Control-backslash> {tkTextKeyCancel %W}

bind Text <Insert> {
	set tkText(%W,ovwrt) [expr !$tkText(%W,ovwrt)]
	if $tkText(%W,ovwrt) {
		set tkBind(%W,mesg) "Entering overwrite mode."
	} else {
		set tkBind(%W,mesg) "Leaving overwrite mode."
	}
}

#key bindings for (printable) keys
bind Text <Any-KeyPress> {
		tkTextInsertChar %W %A
	}
# Special bindings to numeric keys for arguments
for {set n 0} {${n} < 10} {incr n} {
    bind Text <KeyPress-${n}> {tkTextNumKey %W %A}
}
#those bindings are important, it works without this
#bindings on a specified platform _BUT_ don't work
#on another platform.
bind Text <at> {tkTextInsertChar %W %A}
bind Text <numbersign> {tkTextInsertChar %W %A}
bind Text <bracketleft> {tkTextInsertChar %W %A}
bind Text <bracketright> {tkTextInsertChar %W %A}
bind Text <braceleft> {tkTextInsertChar %W %A}
bind Text <braceright> {tkTextInsertChar %W %A}
bind Text <backslash> {tkTextInsertChar %W %A}
bind Text <brokenbar> {tkTextInsertChar %W %A}
bind Text <greater> {tkTextInsertChar %W %A}
bind Text <quotedbl> {tkTextInsertChar %W %A}
bind Text <parenright> {tkTextInsertChar %W %A}
catch {bind Text <dead_tilde> {tkTextInsertChar %W %A}}
catch {bind Text <dead_circumflex> {tkTextInsertChar %W %A}}
catch {bind Text <dead_grave> {tkTextInsertChar %W %A}}

#this binding is needed for the french keyboard to
#insert "|", it's bound on <AltGr-minus>
bind Text <minus> {tkTextInsertChar %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 <Escape> {# nothing}

# Additional emacs-like bindings:
bind Text <Control-a> {
	tkTextSetCursor %W [tkTextPlaceHome %W +]
}
bind Text <Control-b> {
	tkTextSetCursor %W [tkTextPlaceChar %W -]
}