head	1.45;
access;
symbols
	core-8-5-9:1.37.2.3
	core-8-5-8:1.37.2.2
	macosx-cocoa-merge:1.43
	macosx-cocoa-premerge:1.42
	macosx-carbon-freeze:1.42
	core-8-5-7:1.37.2.2
	core-8-5-6:1.37
	core-8-6-b1:1.39
	core-8-6-a3:1.38
	core-8-5-5:1.37
	core-8-6-a2:1.38
	core-8-5-4:1.37
	core-8-5-3:1.37
	core-8-6-a1:1.38
	core-8-4-19:1.22.2.7
	core-8-5-branch:1.37.0.2
	core-8-5-2:1.37
	core-8-4-18:1.22.2.7
	core-8-5-1:1.37
	core-8-4-17:1.22.2.7
	core-8-5-0:1.37
	core-8-5-b3:1.36
	core-8-5-b2:1.33
	core-8-4-16:1.22.2.5
	core-8-5-b1:1.31
	core-stablilizer-merge:1.31
	core-stabilizer-branch:1.31.0.2
	core-stabilizer-merge:1.37
	core-8-4-15:1.22.2.5
	core-8-5-a6:1.31
	core-8-5-a5:1.31
	core-8-4-14:1.22.2.5
	core-8-5-a4:1.31
	core-8-4-13:1.22.2.5
	core-8-4-12:1.22.2.4
	core-8-4-11:1.22.2.3
	core-8-5-a3:1.28
	core-8-4-10:1.22.2.3
	core-8-4-9-branch:1.22.2.1.0.2
	core-8-5-a2:1.26
	core-8-4-9:1.22.2.1
	core-8-4-8:1.22.2.1
	core-8-4-7:1.22
	core-8-5-a1:1.24
	core-8-4-6:1.22
	core-8-4-5:1.22
	mistachkin-dev-branch:1.24.0.2
	core-8-4-4:1.22
	core-8-4-3:1.22
	core-8-4-branch:1.22.0.2
	core-8-4-2:1.22
	core-8-4-1:1.21
	core-8-3-5:1.8.2.6
	core-8-4-0:1.21
	macosx-8-4-merge-2002-08-31-trunk:1.21
	macosx-8-4-premerge-2002-08-31-branch:1.13.2.6
	macosx-8-4-premerge-2002-08-31-trunk:1.20
	macosx-8-4-merge-2002-08-30-branch:1.13.2.5
	macosx-8-4-merge-2002-08-30-trunk:1.20
	macosx-8-4-merge-2002-08-20-branch:1.13.2.4
	macosx-8-4-merge-2002-08-20-trunk:1.20
	core-8-4-b2:1.20
	core-8-4-b1:1.20
	macosx-premerge-6-9-02:1.13.2.2
	core-8-4-a4:1.17
	core-8-3-4:1.8.2.4
	macosx-8-4-branch:1.13.0.2
	macosx-8-4-branchpoint:1.13
	core-8-4-a3:1.12
	core-8-3-3:1.8
	dgp-privates-into-namespace:1.10.0.4
	tclpro-1-5-0:1.8
	core-8-4-win-speedup:1.10.0.2
	core-8-4-a2:1.10
	tclpro-1-4-1:1.8
	tclpro-1-4-0:1.8
	core-8-3-2:1.8
	ajuba-ajuba2-2-1-base:1.8
	ajuba-ajuba2-2-0:1.8
	core-8-4-a1:1.8
	core-8-3-1-branch:1.8.0.2
	core-8-3-1:1.8
	scriptics-sc-2-0-b5:1.7
	scriptics-sc-2-0-fixed:1.7
	scriptics-sc-2-0-b2:1.7
	scriptics-sc-2-0-b1:1.7
	core-8-3-0:1.7
	core-8-3-b2:1.7
	core-8-3-b1:1.7
	scriptics-sc-1-1:1.6
	scriptics-sc-1-1-b1:1.6
	core-8-2-3:1.6
	scriptics-sc-1-1-branch:1.6.0.8
	scriptics-sc-1-1-base:1.6
	scriptics-sc-1-0:1.6
	scriptics-sc-1-0-branch:1.6.0.6
	scriptics-sc-1-0-base:1.6
	core-8-2-2:1.6
	core-8-2-1:1.6
	scriptics-bc-1-0-b1:1.6
	core-8-2-1-branch:1.6.0.4
	scriptics-tclpro-1-3-0:1.6
	core-8-2-0:1.6
	core-8-2-b3-branch:1.6.0.2
	core-8-2-b3-base:1.6
	scriptics-tclpro-1-3-b4:1.5
	core-8-2-b2:1.5
	scriptics-tclpro-1-3-b3:1.5
	core-8-2-b1:1.5
	scriptics-tclpro-1-3-b2:1.4.2.1
	merge-to-mainline-5/21/99:1.4.2.1
	scriptics-tclpro-1-3-b2-branch:1.4.0.2
	core-8-1-1:1.4.2.1
	scriptics-tclpro-1-3-b1:1.4
	core-8-1-1-base:1.4
	core-8-1-0:1.4
	merge-to-mainline-4-29-99:1.4
	merge-to-mainline-4-23-99:1.4
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.3.0.6
	core-8-0-6-base:1.3
	core-8-0-5:1.3
	core-8-1-b3:1.1.4.3
	core-8-1-b2:1.1.4.2
	dev-8-1-stubs-branch:1.1.4.2.0.2
	dev-stubs-branch:1.3.0.4
	scriptics-tclpro-1-2:1.3
	scriptics-tclpro-1-2-b2:1.3
	core-8-1-merge-2/10/99:1.3
	core-8-0-5-branch:1.3.0.2
	core-8-0-5-base:1.3
	scriptics-tclpro-1-2-b1:1.3
	scriptics-tclpro-1-2-a1:1.3
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.3
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.3;
locks; strict;
comment	@# @;


1.45
date	2010.01.04.14.30.50;	author patthoyts;	state Exp;
branches;
next	1.44;

1.44
date	2010.01.04.13.53.17;	author patthoyts;	state Exp;
branches;
next	1.43;

1.43
date	2009.06.29.14.35.01;	author das;	state Exp;
branches;
next	1.42;

1.42
date	2009.04.10.16.31.44;	author das;	state Exp;
branches;
next	1.41;

1.41
date	2009.02.21.10.22.58;	author patthoyts;	state Exp;
branches;
next	1.40;

1.40
date	2009.01.30.21.02.13;	author patthoyts;	state Exp;
branches;
next	1.39;

1.39
date	2008.12.10.05.02.51;	author das;	state Exp;
branches;
next	1.38;

1.38
date	2008.05.13.13.25.18;	author patthoyts;	state Exp;
branches;
next	1.37;

1.37
date	2007.12.13.15.26.27;	author dgp;	state Exp;
branches
	1.37.2.1;
next	1.36;

1.36
date	2007.11.09.06.23.28;	author das;	state Exp;
branches;
next	1.35;

1.35
date	2007.11.04.10.38.29;	author das;	state Exp;
branches;
next	1.34;

1.34
date	2007.11.03.00.51.23;	author patthoyts;	state Exp;
branches;
next	1.33;

1.33
date	2007.10.20.09.02.40;	author patthoyts;	state Exp;
branches;
next	1.32;

1.32
date	2007.10.12.09.28.29;	author patthoyts;	state Exp;
branches;
next	1.31;

1.31
date	2006.01.25.18.22.04;	author dgp;	state Exp;
branches
	1.31.2.1;
next	1.30;

1.30
date	2005.11.30.01.24.48;	author hobbs;	state Exp;
branches;
next	1.29;

1.29
date	2005.07.25.09.06.01;	author dkf;	state Exp;
branches;
next	1.28;

1.28
date	2005.05.31.04.59.38;	author hobbs;	state Exp;
branches;
next	1.27;

1.27
date	2005.05.30.23.41.01;	author hobbs;	state Exp;
branches;
next	1.26;

1.26
date	2004.11.17.22.16.44;	author hobbs;	state Exp;
branches;
next	1.25;

1.25
date	2004.03.17.18.15.44;	author das;	state Exp;
branches;
next	1.24;

1.24
date	2003.10.02.23.02.36;	author patthoyts;	state Exp;
branches;
next	1.23;

1.23
date	2003.05.19.14.44.03;	author dkf;	state Exp;
branches;
next	1.22;

1.22
date	2003.02.21.03.34.29;	author das;	state Exp;
branches
	1.22.2.1;
next	1.21;

1.21
date	2002.08.31.06.12.28;	author das;	state Exp;
branches;
next	1.20;

1.20
date	2002.06.22.08.50.43;	author hobbs;	state Exp;
branches;
next	1.19;

1.19
date	2002.05.20.10.21.23;	author das;	state Exp;
branches;
next	1.18;

1.18
date	2002.04.29.13.17.44;	author bagnonm;	state Exp;
branches;
next	1.17;

1.17
date	2002.03.01.00.04.27;	author dgp;	state Exp;
branches;
next	1.16;

1.16
date	2001.11.23.02.04.17;	author das;	state Exp;
branches;
next	1.15;

1.15
date	2001.10.19.17.43.52;	author hobbs;	state Exp;
branches;
next	1.14;

1.14
date	2001.10.18.20.26.42;	author hobbs;	state Exp;
branches;
next	1.13;

1.13
date	2001.10.09.23.11.02;	author hobbs;	state Exp;
branches
	1.13.2.1;
next	1.12;

1.12
date	2001.08.01.16.21.11;	author dgp;	state Exp;
branches;
next	1.11;

1.11
date	2001.07.03.01.03.16;	author hobbs;	state Exp;
branches;
next	1.10;

1.10
date	2000.11.02.22.55.16;	author hobbs;	state Exp;
branches
	1.10.2.1
	1.10.4.1;
next	1.9;

1.9
date	2000.06.30.06.38.38;	author ericm;	state Exp;
branches;
next	1.8;

1.8
date	2000.04.21.04.06.37;	author hobbs;	state Exp;
branches
	1.8.2.1;
next	1.7;

1.7
date	99.09.02.17.02.52;	author hobbs;	state Exp;
branches;
next	1.6;

1.6
date	99.08.10.15.27.49;	author hobbs;	state Exp;
branches;
next	1.5;

1.5
date	99.05.22.01.59.21;	author stanton;	state Exp;
branches;
next	1.4;

1.4
date	99.04.16.01.51.26;	author stanton;	state Exp;
branches
	1.4.2.1;
next	1.3;

1.3
date	98.09.14.18.23.22;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.06.27.18.06.38;	author welch;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.55.07;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.30;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.17.31;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	99.04.06.03.52.51;	author stanton;	state Exp;
branches;
next	;

1.4.2.1
date	99.05.20.22.32.26;	author redman;	state Exp;
branches;
next	;

1.8.2.1
date	2001.10.09.23.10.31;	author hobbs;	state Exp;
branches;
next	1.8.2.2;

1.8.2.2
date	2001.10.18.20.26.24;	author hobbs;	state Exp;
branches;
next	1.8.2.3;

1.8.2.3
date	2001.10.19.17.33.27;	author hobbs;	state Exp;
branches;
next	1.8.2.4;

1.8.2.4
date	2001.10.19.19.40.17;	author das;	state Exp;
branches;
next	1.8.2.5;

1.8.2.5
date	2002.03.01.00.03.57;	author dgp;	state Exp;
branches;
next	1.8.2.6;

1.8.2.6
date	2002.06.22.08.52.24;	author hobbs;	state Exp;
branches;
next	;

1.10.2.1
date	2002.04.06.01.02.01;	author hobbs;	state Exp;
branches;
next	;

1.10.4.1
date	2001.02.28.23.29.56;	author dgp;	state Exp;
branches;
next	1.10.4.2;

1.10.4.2
date	2001.07.03.20.01.09;	author dgp;	state Exp;
branches;
next	1.10.4.3;

1.10.4.3
date	2001.07.17.00.21.37;	author dgp;	state Exp;
branches;
next	;

1.13.2.1
date	2001.10.15.09.22.00;	author wolfsuit;	state Exp;
branches;
next	1.13.2.2;

1.13.2.2
date	2002.02.05.02.25.16;	author wolfsuit;	state Exp;
branches;
next	1.13.2.3;

1.13.2.3
date	2002.06.10.05.38.24;	author wolfsuit;	state Exp;
branches;
next	1.13.2.4;

1.13.2.4
date	2002.08.20.20.27.09;	author das;	state Exp;
branches;
next	1.13.2.5;

1.13.2.5
date	2002.08.21.12.28.55;	author das;	state Exp;
branches;
next	1.13.2.6;

1.13.2.6
date	2002.08.30.18.18.13;	author das;	state Exp;
branches;
next	;

1.22.2.1
date	2004.11.17.22.18.28;	author hobbs;	state Exp;
branches;
next	1.22.2.2;

1.22.2.2
date	2005.05.30.23.40.33;	author hobbs;	state Exp;
branches;
next	1.22.2.3;

1.22.2.3
date	2005.05.31.04.58.00;	author hobbs;	state Exp;
branches;
next	1.22.2.4;

1.22.2.4
date	2005.11.30.01.22.55;	author hobbs;	state Exp;
branches;
next	1.22.2.5;

1.22.2.5
date	2006.01.25.18.21.41;	author dgp;	state Exp;
branches;
next	1.22.2.6;

1.22.2.6
date	2007.11.09.06.26.54;	author das;	state Exp;
branches;
next	1.22.2.7;

1.22.2.7
date	2007.11.09.07.08.51;	author das;	state Exp;
branches;
next	;

1.31.2.1
date	2007.10.15.18.38.34;	author dgp;	state Exp;
branches;
next	1.31.2.2;

1.31.2.2
date	2007.10.24.12.59.33;	author dgp;	state Exp;
branches;
next	1.31.2.3;

1.31.2.3
date	2007.11.05.14.24.18;	author dgp;	state Exp;
branches;
next	1.31.2.4;

1.31.2.4
date	2007.11.12.19.22.38;	author dgp;	state Exp;
branches;
next	;

1.37.2.1
date	2009.01.30.21.06.05;	author patthoyts;	state Exp;
branches;
next	1.37.2.2;

1.37.2.2
date	2009.04.10.16.29.18;	author das;	state Exp;
branches;
next	1.37.2.3;

1.37.2.3
date	2010.01.04.21.34.12;	author patthoyts;	state Exp;
branches;
next	;


desc
@@


1.45
log
@Fix the console <<Cut>> binding to actually remove text
@
text
@# console.tcl --
#
# This code constructs the console window for an application.  It
# can be used by non-unix systems that do not have built-in support
# for shells.
#
# RCS: @@(#) $Id: console.tcl,v 1.44 2010/01/04 13:53:17 patthoyts Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2007-2008 Daniel A. Steffen <das@@users.sourceforge.net>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# TODO: history - remember partially written command

namespace eval ::tk::console {
    variable blinkTime   500 ; # msecs to blink braced range for
    variable blinkRange  1   ; # enable blinking of the entire braced range
    variable magicKeys   1   ; # enable brace matching and proc/var recognition
    variable maxLines    600 ; # maximum # of lines buffered in console
    variable showMatches 1   ; # show multiple expand matches
    variable useFontchooser [llength [info command ::tk::fontchooser]]
    variable inPlugin [info exists embed_args]
    variable defaultPrompt   ; # default prompt if tcl_prompt1 isn't used

    if {$inPlugin} {
	set defaultPrompt {subst {[history nextid] % }}
    } else {
	set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
    }
}

# simple compat function for tkcon code added for this console
interp alias {} EvalAttached {} consoleinterp eval

# ::tk::ConsoleInit --
# This procedure constructs and configures the console windows.
#
# Arguments:
# 	None.

proc ::tk::ConsoleInit {} {
    global tcl_platform

    if {![consoleinterp eval {set tcl_interactive}]} {
	wm withdraw .
    }

    if {[tk windowingsystem] eq "aqua"} {
	set mod "Cmd"
    } else {
	set mod "Ctrl"
    }

    if {[catch {menu .menubar} err]} {
	bgerror "INIT: $err"
    }
    AmpMenuArgs .menubar add cascade -label [mc &File] -menu .menubar.file
    AmpMenuArgs .menubar add cascade -label [mc &Edit] -menu .menubar.edit

    menu .menubar.file -tearoff 0
    AmpMenuArgs .menubar.file add command -label [mc "&Source..."] \
	    -command {tk::ConsoleSource}
    AmpMenuArgs .menubar.file add command -label [mc "&Hide Console"] \
	    -command {wm withdraw .}
    AmpMenuArgs .menubar.file add command -label [mc "&Clear Console"] \
	    -command {.console delete 1.0 "promptEnd linestart"}
    if {[tk windowingsystem] ne "aqua"} {
	AmpMenuArgs .menubar.file add command -label [mc E&xit] -command {exit}
    }

    menu .menubar.edit -tearoff 0
    AmpMenuArgs	.menubar.edit add command -label [mc Cu&t]   -accel "$mod+X"\
	    -command {event generate .console <<Cut>>}
    AmpMenuArgs	.menubar.edit add command -label [mc &Copy]  -accel "$mod+C"\
	    -command {event generate .console <<Copy>>}
    AmpMenuArgs	.menubar.edit add command -label [mc P&aste] -accel "$mod+V"\
	    -command {event generate .console <<Paste>>}

    if {$tcl_platform(platform) ne "windows"} {
	AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \
		-command {event generate .console <<Clear>>}
    } else {
	AmpMenuArgs .menubar.edit add command -label [mc &Delete] \
		-command {event generate .console <<Clear>>} -accel "Del"

	AmpMenuArgs .menubar add cascade -label [mc &Help] -menu .menubar.help
	menu .menubar.help -tearoff 0
	AmpMenuArgs .menubar.help add command -label [mc &About...] \
		-command tk::ConsoleAbout
    }

    AmpMenuArgs .menubar.edit add separator
    if {$::tk::console::useFontchooser} {
        if {[tk windowingsystem] eq "aqua"} {
            .menubar.edit add command -label tk_choose_font_marker
            set index [.menubar.edit index tk_choose_font_marker]
            .menubar.edit entryconfigure $index \
                -label [mc "Show Fonts"]\
                -accelerator "$mod-T"\
                -command [list ::tk::console::FontchooserToggle]
            bind Console <<TkFontchooserVisibility>> \
                [list ::tk::console::FontchooserVisibility $index]
	    ::tk::console::FontchooserVisibility $index
        } else {
            AmpMenuArgs .menubar.edit add command -label [mc "&Font..."] \
                -command [list ::tk::console::FontchooserToggle]
        }
	bind Console <FocusIn>  [list ::tk::console::FontchooserFocus %W 1]
	bind Console <FocusOut> [list ::tk::console::FontchooserFocus %W 0]
    }
    AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \
        -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
    AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
        -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>}

    if {[tk windowingsystem] eq "aqua"} {
	.menubar add cascade -label [mc Window] -menu [menu .menubar.window]
	.menubar add cascade -label [mc Help] -menu [menu .menubar.help]
    }

    . configure -menu .menubar

    # See if we can find a better font than the TkFixedFont
    catch {font create TkConsoleFont {*}[font configure TkFixedFont]}
    set families [font families]
    switch -exact -- [tk windowingsystem] {
        aqua { set preferred {Monaco 10} }
        win32 { set preferred {ProFontWindows 8 Consolas 8} }
        default { set preferred {} }
    }
    foreach {family size} $preferred {
        if {[lsearch -exact $families $family] != -1} {
            font configure TkConsoleFont -family $family -size $size
            break
        }
    }

    # Provide the right border for the text widget (platform dependent).
    ::ttk::style layout ConsoleFrame {
        Entry.field -sticky news -border 1 -children {
            ConsoleFrame.padding -sticky news
        }
    }
    ::ttk::frame .consoleframe -style ConsoleFrame

    set con [text .console -yscrollcommand [list .sb set] -setgrid true \
                 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont]
    if {[tk windowingsystem] eq "aqua"} {
        scrollbar .sb -command [list $con yview]
    } else {
        ::ttk::scrollbar .sb -command [list $con yview]
    }
    pack .sb  -in .consoleframe -fill both -side right -padx 1 -pady 1
    pack $con -in .consoleframe -fill both -expand 1 -side left -padx 1 -pady 1
    pack .consoleframe -fill both -expand 1 -side left

    ConsoleBind $con

    $con tag configure stderr	-foreground red
    $con tag configure stdin	-foreground blue
    $con tag configure prompt	-foreground \#8F4433
    $con tag configure proc	-foreground \#008800
    $con tag configure var	-background \#FFC0D0
    $con tag raise sel
    $con tag configure blink	-background \#FFFF00
    $con tag configure find	-background \#FFFF00

    focus $con

    # Avoid listing this console in [winfo interps]
    if {[info command ::send] eq "::send"} {rename ::send {}}

    wm protocol . WM_DELETE_WINDOW { wm withdraw . }
    wm title . [mc "Console"]
    flush stdout
    $con mark set output [$con index "end - 1 char"]
    tk::TextSetCursor $con end
    $con mark set promptEnd insert
    $con mark gravity promptEnd left

    # A variant of ConsolePrompt to avoid a 'puts' call
    set w $con
    set temp [$w index "end - 1 char"]
    $w mark set output end
    if {![consoleinterp eval "info exists tcl_prompt1"]} {
	set string [EvalAttached $::tk::console::defaultPrompt]
	$w insert output $string stdout
    }
    $w mark set output $temp
    ::tk::TextSetCursor $w end
    $w mark set promptEnd insert
    $w mark gravity promptEnd left

    if {$tcl_platform(platform) eq "windows"} {
	# Subtle work-around to erase the '% ' that tclMain.c prints out
	after idle [subst -nocommand {
	    if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output }
	}]
    }
}

# ::tk::ConsoleSource --
#
# Prompts the user for a file to source in the main interpreter.
#
# Arguments:
# None.

proc ::tk::ConsoleSource {} {
    set filename [tk_getOpenFile -defaultextension .tcl -parent . \
	    -title [mc "Select a file to source"] \
	    -filetypes [list \
	    [list [mc "Tcl Scripts"] .tcl] \
	    [list [mc "All Files"] *]]]
    if {$filename ne ""} {
    	set cmd [list source $filename]
	if {[catch {consoleinterp eval $cmd} result]} {
	    ConsoleOutput stderr "$result\n"
	}
    }
}

# ::tk::ConsoleInvoke --
# Processes the command line input.  If the command is complete it
# is evaled in the main interpreter.  Otherwise, the continuation
# prompt is added and more input may be added.
#
# Arguments:
# None.

proc ::tk::ConsoleInvoke {args} {
    set ranges [.console tag ranges input]
    set cmd ""
    if {[llength $ranges]} {
	set pos 0
	while {[lindex $ranges $pos] ne ""} {
	    set start [lindex $ranges $pos]
	    set end [lindex $ranges [incr pos]]
	    append cmd [.console get $start $end]
	    incr pos
	}
    }
    if {$cmd eq ""} {
	ConsolePrompt
    } elseif {[info complete $cmd]} {
	.console mark set output end
	.console tag delete input
	set result [consoleinterp record $cmd]
	if {$result ne ""} {
	    puts $result
	}
	ConsoleHistory reset
	ConsolePrompt
    } else {
	ConsolePrompt partial
    }
    .console yview -pickplace insert
}

# ::tk::ConsoleHistory --
# This procedure implements command line history for the
# console.  In general is evals the history command in the
# main interpreter to obtain the history.  The variable
# ::tk::HistNum is used to store the current location in the history.
#
# Arguments:
# cmd -	Which action to take: prev, next, reset.

set ::tk::HistNum 1
proc ::tk::ConsoleHistory {cmd} {
    variable HistNum

    switch $cmd {
    	prev {
	    incr HistNum -1
	    if {$HistNum == 0} {
		set cmd {history event [expr {[history nextid] -1}]}
	    } else {
		set cmd "history event $HistNum"
	    }
    	    if {[catch {consoleinterp eval $cmd} cmd]} {
    	    	incr HistNum
    	    	return
    	    }
	    .console delete promptEnd end
    	    .console insert promptEnd $cmd {input stdin}
    	}
    	next {
	    incr HistNum
	    if {$HistNum == 0} {
		set cmd {history event [expr {[history nextid] -1}]}
	    } elseif {$HistNum > 0} {
		set cmd ""
		set HistNum 1
	    } else {
		set cmd "history event $HistNum"
	    }
	    if {$cmd ne ""} {
		catch {consoleinterp eval $cmd} cmd
	    }
	    .console delete promptEnd end
	    .console insert promptEnd $cmd {input stdin}
    	}
    	reset {
    	    set HistNum 1
    	}
    }
}

# ::tk::ConsolePrompt --
# This procedure draws the prompt.  If tcl_prompt1 or tcl_prompt2
# exists in the main interpreter it will be called to generate the 
# prompt.  Otherwise, a hard coded default prompt is printed.
#
# Arguments:
# partial -	Flag to specify which prompt to print.

proc ::tk::ConsolePrompt {{partial normal}} {
    set w .console
    if {$partial eq "normal"} {
	set temp [$w index "end - 1 char"]
	$w mark set output end
    	if {[consoleinterp eval "info exists tcl_prompt1"]} {
    	    consoleinterp eval "eval \[set tcl_prompt1\]"
    	} else {
    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
    	}
    } else {
	set temp [$w index output]
	$w mark set output end
    	if {[consoleinterp eval "info exists tcl_prompt2"]} {
    	    consoleinterp eval "eval \[set tcl_prompt2\]"
    	} else {
	    puts -nonewline "> "
    	}
    }
    flush stdout
    $w mark set output $temp
    ::tk::TextSetCursor $w end
    $w mark set promptEnd insert
    $w mark gravity promptEnd left
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
    $w see end
}

# Copy selected text from the console
proc ::tk::console::Copy {w} {
    if {![catch {set data [$w get sel.first sel.last]}]} {
        clipboard clear -displayof $w
        clipboard append -displayof $w $data
    }
}
# Copies selected text. If the selection is within the current active edit
# region then it will be cut, if not it is only copied.
proc ::tk::console::Cut {w} {
    if {![catch {set data [$w get sel.first sel.last]}]} {
        clipboard clear -displayof $w
        clipboard append -displayof $w $data
        if {[$w compare sel.first >= output]} {
            $w delete sel.first sel.last
	}
    }
}
# Paste text from the clipboard
proc ::tk::console::Paste {w} {
    catch {
        set clip [::tk::GetSelection $w CLIPBOARD]
        set list [split $clip \n\r]
        tk::ConsoleInsert $w [lindex $list 0]
        foreach x [lrange $list 1 end] {
            $w mark set insert {end - 1c}
            tk::ConsoleInsert $w "\n"
            tk::ConsoleInvoke
            tk::ConsoleInsert $w $x
        }
    }
}

# ::tk::ConsoleBind --
# This procedure first ensures that the default bindings for the Text
# class have been defined.  Then certain bindings are overridden for
# the class.
#
# Arguments:
# None.

proc ::tk::ConsoleBind {w} {
    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]

    ## Get all Text bindings into Console
    foreach ev [bind Text] {
	bind Console $ev [bind Text $ev]
    }
    ## We really didn't want the newline insertion...
    bind Console <Control-Key-o> {}
    ## ...or any Control-v binding (would block <<Paste>>)
    bind Console <Control-Key-v> {}

    # For the moment, transpose isn't enabled until the console
    # gets and overhaul of how it handles input -- hobbs
    bind Console <Control-Key-t> {}

    # 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.

    bind Console <Alt-KeyPress> {# nothing }
    bind Console <Meta-KeyPress> {# nothing}
    bind Console <Control-KeyPress> {# nothing}

    foreach {ev key} {
	<<Console_Prev>>		<Key-Up>
	<<Console_Next>>		<Key-Down>
	<<Console_NextImmediate>>	<Control-Key-n>
	<<Console_PrevImmediate>>	<Control-Key-p>
	<<Console_PrevSearch>>		<Control-Key-r>
	<<Console_NextSearch>>		<Control-Key-s>

	<<Console_Expand>>		<Key-Tab>
	<<Console_Expand>>		<Key-Escape>
	<<Console_ExpandFile>>		<Control-Shift-Key-F>
	<<Console_ExpandProc>>		<Control-Shift-Key-P>
	<<Console_ExpandVar>>		<Control-Shift-Key-V>
	<<Console_Tab>>			<Control-Key-i>
	<<Console_Tab>>			<Meta-Key-i>
	<<Console_Eval>>		<Key-Return>
	<<Console_Eval>>		<Key-KP_Enter>

	<<Console_Clear>>		<Control-Key-l>
	<<Console_KillLine>>		<Control-Key-k>
	<<Console_Transpose>>		<Control-Key-t>
	<<Console_ClearLine>>		<Control-Key-u>
	<<Console_SaveCommand>>		<Control-Key-z>
        <<Console_FontSizeIncr>>	<Control-Key-plus>
        <<Console_FontSizeDecr>>	<Control-Key-minus>
    } {
	event add $ev $key
	bind Console $key {}
    }
    if {[tk windowingsystem] eq "aqua"} {
	foreach {ev key} {
	    <<Console_FontSizeIncr>>	<Command-Key-plus>
	    <<Console_FontSizeDecr>>	<Command-Key-minus>
	} {
	    event add $ev $key
	    bind Console $key {}
	}
	if {$::tk::console::useFontchooser} {
	    bind Console <Command-Key-t> [list ::tk::console::FontchooserToggle]
	}
    }
    bind Console <<Console_Expand>> {
	if {[%W compare insert > promptEnd]} {
	    ::tk::console::Expand %W
	}
    }
    bind Console <<Console_ExpandFile>> {
	if {[%W compare insert > promptEnd]} {
	    ::tk::console::Expand %W path
	}
    }
    bind Console <<Console_ExpandProc>> {
	if {[%W compare insert > promptEnd]} {
	    ::tk::console::Expand %W proc
	}
    }
    bind Console <<Console_ExpandVar>> {
	if {[%W compare insert > promptEnd]} {
	    ::tk::console::Expand %W var
	}
    }
    bind Console <<Console_Eval>> {
	%W mark set insert {end - 1c}
	tk::ConsoleInsert %W "\n"
	tk::ConsoleInvoke
	break
    }
    bind Console <Delete> {
	if {{} ne [%W tag nextrange sel 1.0 end] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert >= promptEnd]} {
	    %W delete insert
	    %W see insert
	}
    }
    bind Console <BackSpace> {
	if {{} ne [%W tag nextrange sel 1.0 end] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert != 1.0] && \
		[%W compare insert > promptEnd]} {
	    %W delete insert-1c
	    %W see insert
	}
    }
    bind Console <Control-h> [bind Console <BackSpace>]

    bind Console <Home> {
	if {[%W compare insert < promptEnd]} {
	    tk::TextSetCursor %W {insert linestart}
	} else {
	    tk::TextSetCursor %W promptEnd
	}
    }
    bind Console <Control-a> [bind Console <Home>]
    bind Console <End> {
	tk::TextSetCursor %W {insert lineend}
    }
    bind Console <Control-e> [bind Console <End>]
    bind Console <Control-d> {
	if {[%W compare insert < promptEnd]} {
	    break
	}
	%W delete insert
    }
    bind Console <<Console_KillLine>> {
	if {[%W compare insert < promptEnd]} {
	    break
	}
	if {[%W compare insert == {insert lineend}]} {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
	}
    }
    bind Console <<Console_Clear>> {
	## Clear console display
	%W delete 1.0 "promptEnd linestart"
    }
    bind Console <<Console_ClearLine>> {
	## Clear command line (Unix shell staple)
	%W delete promptEnd end
    }
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
	}
    }
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
	}
    }
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
	}
    }
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
	}
    }
    bind Console <Meta-Delete> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
	}
    }
    bind Console <<Console_Prev>> {
	tk::ConsoleHistory prev
    }
    bind Console <<Console_Next>> {
	tk::ConsoleHistory next
    }
    bind Console <Insert> {
	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
    }
    bind Console <KeyPress> {
	tk::ConsoleInsert %W %A
    }
    bind Console <F9> {
	eval destroy [winfo child .]
	source [file join $tk_library console.tcl]
    }
    if {[tk windowingsystem] eq "aqua"} {
	bind Console <Command-q> {
	    exit
	}
    }
    bind Console <<Cut>> { ::tk::console::Cut %W }
    bind Console <<Copy>> { ::tk::console::Copy %W }
    bind Console <<Paste>> { ::tk::console::Paste %W }

    bind Console <<Console_FontSizeIncr>> {
        set size [font configure TkConsoleFont -size]
        if {$size < 0} {set sign -1} else {set sign 1}
        set size [expr {(abs($size) + 1) * $sign}]
        font configure TkConsoleFont -size $size
	if {$::tk::console::useFontchooser} {
	    tk fontchooser configure -font TkConsoleFont
	}
    }
    bind Console <<Console_FontSizeDecr>> {
        set size [font configure TkConsoleFont -size]
        if {abs($size) < 2} { return }
        if {$size < 0} {set sign -1} else {set sign 1}
        set size [expr {(abs($size) - 1) * $sign}]
        font configure TkConsoleFont -size $size
	if {$::tk::console::useFontchooser} {
	    tk fontchooser configure -font TkConsoleFont
	}
    }

    ##
    ## Bindings for doing special things based on certain keys
    ##
    bind PostConsole <Key-parenright> {
	if {"\\" ne [%W get insert-2c]} {
	    ::tk::console::MatchPair %W \( \) promptEnd
	}
    }
    bind PostConsole <Key-bracketright> {
	if {"\\" ne [%W get insert-2c]} {
	    ::tk::console::MatchPair %W \[ \] promptEnd
	}
    }
    bind PostConsole <Key-braceright> {
	if {"\\" ne [%W get insert-2c]} {
	    ::tk::console::MatchPair %W \{ \} promptEnd
	}
    }
    bind PostConsole <Key-quotedbl> {
	if {"\\" ne [%W get insert-2c]} {
	    ::tk::console::MatchQuote %W promptEnd
	}
    }

    bind PostConsole <KeyPress> {
	if {"%A" ne ""} {
	    ::tk::console::TagProc %W
	}
    }
}

# ::tk::ConsoleInsert --
# Insert a string into a text at the point of the insertion cursor.
# If there is a selection in the text, and it covers the point of the
# insertion cursor, then delete the selection before inserting.  Insertion
# is restricted to the prompt area.
#
# Arguments:
# w -		The text window in which to insert the string
# s -		The string to insert (usually just a single character)

proc ::tk::ConsoleInsert {w s} {
    if {$s eq ""} {
	return
    }
    catch {
	if {[$w compare sel.first <= insert] \
		&& [$w compare sel.last >= insert]} {
	    $w tag remove sel sel.first promptEnd
	    $w delete sel.first sel.last
	}
    }
    if {[$w compare insert < promptEnd]} {
	$w mark set insert end
    }
    $w insert insert $s {input stdin}
    $w see insert
}

# ::tk::ConsoleOutput --
#
# This routine is called directly by ConsolePutsCmd to cause a string
# to be displayed in the console.
#
# Arguments:
# dest -	The output tag to be used: either "stderr" or "stdout".
# string -	The string to be displayed.

proc ::tk::ConsoleOutput {dest string} {
    set w .console
    $w insert output [string map {\0 \u25a1} $string] $dest
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
    $w see insert
}

# ::tk::ConsoleExit --
#
# This routine is called by ConsoleEventProc when the main window of
# the application is destroyed.  Don't call exit - that probably already
# happened.  Just delete our window.
#
# Arguments:
# None.

proc ::tk::ConsoleExit {} {
    destroy .
}

# ::tk::ConsoleAbout --
#
# This routine displays an About box to show Tcl/Tk version info.
#
# Arguments:
# None.

proc ::tk::ConsoleAbout {} {
    tk_messageBox -type ok -message "[mc {Tcl for Windows}]

Tcl $::tcl_patchLevel
Tk $::tk_patchLevel"
}

# ::tk::console::Fontchooser* --
# 	Let the user select the console font (TIP 324).

proc ::tk::console::FontchooserToggle {} {
    if {[tk fontchooser configure -visible]} {
	tk fontchooser hide
    } else {
	tk fontchooser show
    }
}
proc ::tk::console::FontchooserVisibility {index} {
    if {[tk fontchooser configure -visible]} {
	.menubar.edit entryconfigure $index -label [msgcat::mc "Hide Fonts"]
    } else {
	.menubar.edit entryconfigure $index -label [msgcat::mc "Show Fonts"]
    }
}
proc ::tk::console::FontchooserFocus {w isFocusIn} {
    if {$isFocusIn} {
	tk fontchooser configure -parent $w -font TkConsoleFont \
		-command [namespace code [list FontchooserApply]]
    } else {
	tk fontchooser configure -parent $w -font {} -command {}
    }
}
proc ::tk::console::FontchooserApply {font args} {
    catch {font configure TkConsoleFont {*}[font actual $font]}
}

# ::tk::console::TagProc --
#
# Tags a procedure in the console if it's recognized
# This procedure is not perfect.  However, making it perfect wastes
# too much CPU time...
#
# Arguments:
#	w	- console text widget

proc ::tk::console::TagProc w {
    if {!$::tk::console::magicKeys} {
	return
    }
    set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
    set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$i eq ""} {
	set i promptEnd
    } else {
	append i +2c
    }
    regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
    if {[llength [EvalAttached [list info commands $c]]]} {
	$w tag add proc $i "insert-1c wordend"
    } else {
	$w tag remove proc $i "insert-1c wordend"
    }
    if {[llength [EvalAttached [list info vars $c]]]} {
	$w tag add var $i "insert-1c wordend"
    } else {
	$w tag remove var $i "insert-1c wordend"
    }
}

# ::tk::console::MatchPair --
#
# Blinks a matching pair of characters
# c2 is assumed to be at the text index 'insert'.
# This proc is really loopy and took me an hour to figure out given
# all possible combinations with escaping except for escaped \'s.
# It doesn't take into account possible commenting... Oh well.  If
# anyone has something better, I'd like to see/use it.  This is really
# only efficient for small contexts.
#
# Arguments:
#	w	- console text widget
# 	c1	- first char of pair
# 	c2	- second char of pair
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
    if {!$::tk::console::magicKeys} {
	return
    }
    if {{} ne [set ix [$w search -back $c1 insert $lim]]} {
	while {
	    [string match {\\} [$w get $ix-1c]] &&
	    [set ix [$w search -back $c1 $ix-1c $lim]] ne {}
	} {}
	set i1 insert-1c
	while {$ix ne {}} {
	    set i0 $ix
	    set j 0
	    while {[set i0 [$w search $c2 $i0 $i1]] ne {}} {
		append i0 +1c
		if {[string match {\\} [$w get $i0-2c]]} {
		    continue
		}
		incr j
	    }
	    if {!$j} {
		break
	    }
	    set i1 $ix
	    while {$j && [set ix [$w search -back $c1 $ix $lim]] ne {}} {
		if {[string match {\\} [$w get $ix-1c]]} {
		    continue
		}
		incr j -1
	    }
	}
	if {[string match {} $ix]} {
	    set ix [$w index $lim]
	}
    } else {
	set ix [$w index $lim]
    }
    if {$::tk::console::blinkRange} {
	Blink $w $ix [$w index insert]
    } else {
	Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::MatchQuote --
#
# Blinks between matching quotes.
# Blinks just the quote if it's unmatched, otherwise blinks quoted string
# The quote to match is assumed to be at the text index 'insert'.
#
# Arguments:
#	w	- console text widget
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchQuote {w {lim 1.0}} {
    if {!$::tk::console::magicKeys} {
	return
    }
    set i insert-1c
    set j 0
    while {[set i [$w search -back \" $i $lim]] ne {}} {
	if {[string match {\\} [$w get $i-1c]]} {
	    continue
	}
	if {!$j} {
	    set i0 $i
	}
	incr j
    }
    if {$j&1} {
	if {$::tk::console::blinkRange} {
	    Blink $w $i0 [$w index insert]
	} else {
	    Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
	}
    } else {
	Blink $w [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::Blink --
#
# Blinks between n index pairs for a specified duration.
#
# Arguments:
#	w	- console text widget
# 	i1	- start index to blink region
# 	i2	- end index of blink region
# 	dur	- duration in usecs to blink for
#
# Outputs:
#	blinks selected characters in $w

proc ::tk::console::Blink {w args} {
    eval [list $w tag add blink] $args
    after $::tk::console::blinkTime [list $w] tag remove blink $args
}

# ::tk::console::ConstrainBuffer --
#
# This limits the amount of data in the text widget
# Called by Prompt and ConsoleOutput
#
# Arguments:
#	w	- console text widget
#	size	- # of lines to constrain to
#
# Outputs:
#	may delete data in console widget

proc ::tk::console::ConstrainBuffer {w size} {
    if {[$w index end] > $size} {
	$w delete 1.0 [expr {int([$w index end])-$size}].0
    }
}

# ::tk::console::Expand --
#
# Arguments:
# ARGS:	w	- text widget in which to expand str
# 	type	- type of expansion (path / proc / variable)
#
# Calls:	::tk::console::Expand(Pathname|Procname|Variable)
#
# Outputs:	The string to match is expanded to the longest possible match.
#		If ::tk::console::showMatches is non-zero and the longest match
#		equaled the string to expand, then all possible matches are
#		output to stdout.  Triggers bell if no matches are found.
#
# Returns:	number of matches found

proc ::tk::console::Expand {w {type ""}} {
    set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
    set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$tmp eq ""} {
	set tmp promptEnd
    } else {
	append tmp +2c
    }
    if {[$w compare $tmp >= insert]} {
	return
    }
    set str [$w get $tmp insert]
    switch -glob $type {
	path* {
	    set res [ExpandPathname $str]
	}
	proc* {
	    set res [ExpandProcname $str]
	}
	var* {
	    set res [ExpandVariable $str]
	}
	default {
	    set res {}
	    foreach t {Pathname Procname Variable} {
		if {![catch {Expand$t $str} res] && ($res ne "")} {
		    break
		}
	    }
	}
    }
    set len [llength $res]
    if {$len} {
	set repl [lindex $res 0]
	$w delete $tmp insert
	$w insert $tmp $repl {input stdin}
	if {($len > 1) && ($::tk::console::showMatches) && ($repl eq $str)} {
	    puts stdout [lsort [lreplace $res 0 0]]
	}
    } else {
	bell
    }
    return [incr len -1]
}

# ::tk::console::ExpandPathname --
#
# Expand a file pathname based on $str
# This is based on UNIX file name conventions
#
# Arguments:
#	str	- partial file pathname to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches
 
proc ::tk::console::ExpandPathname str {
    set pwd [EvalAttached pwd]
    if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
	return -code error $err
    }
    set dir [file tail $str]
    ## Check to see if it was known to be a directory and keep the trailing
    ## slash if so (file tail cuts it off)
    if {[string match */ $str]} {
	append dir /
    }
    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
	set match {}
    } else {
	if {[llength $m] > 1} {
	    global tcl_platform
	    if {[string match windows $tcl_platform(platform)]} {
		## Windows is screwy because it's case insensitive
		set tmp [ExpandBestMatch [string tolower $m] \
			[string tolower $dir]]
		## Don't change case if we haven't changed the word
		if {[string length $dir]==[string length $tmp]} {
		    set tmp $dir
		}
	    } else {
		set tmp [ExpandBestMatch $m $dir]
	    }
	    if {[string match ?*/* $str]} {
		set tmp [file dirname $str]/$tmp
	    } elseif {[string match /* $str]} {
		set tmp /$tmp
	    }
	    regsub -all { } $tmp {\\ } tmp
	    set match [linsert $m 0 $tmp]
	} else {
	    ## This may look goofy, but it handles spaces in path names
	    eval append match $m
	    if {[file isdir $match]} {
		append match /
	    }
	    if {[string match ?*/* $str]} {
		set match [file dirname $str]/$match
	    } elseif {[string match /* $str]} {
		set match /$match
	    }
	    regsub -all { } $match {\\ } match
	    ## Why is this one needed and the ones below aren't!!
	    set match [list $match]
	}
    }
    EvalAttached [list cd $pwd]
    return $match
}

# ::tk::console::ExpandProcname --
#
# Expand a tcl proc name based on $str
#
# Arguments:
#	str	- partial proc name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandProcname str {
    set match [EvalAttached [list info commands $str*]]
    if {[llength $match] == 0} {
	set ns [EvalAttached \
		"namespace children \[namespace current\] [list $str*]"]
	if {[llength $ns]==1} {
	    set match [EvalAttached [list info commands ${ns}::*]]
	} else {
	    set match $ns
	}
    }
    if {[llength $match] > 1} {
	regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	set match [linsert $match 0 $str]
    } else {
	regsub -all { } $match {\\ } match
    }
    return $match
}

# ::tk::console::ExpandVariable --
#
# Expand a tcl variable name based on $str
#
# Arguments:
#	str	- partial tcl var name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandVariable str {
    if {[regexp {([^\(]*)\((.*)} $str -> ary str]} {
	## Looks like they're trying to expand an array.
	set match [EvalAttached [list array names $ary $str*]]
	if {[llength $match] > 1} {
	    set vars $ary\([ExpandBestMatch $match $str]
	    foreach var $match {
		lappend vars $ary\($var\)
	    }
	    return $vars
	} elseif {[llength $match] == 1} {
	    set match $ary\($match\)
	}
	## Space transformation avoided for array names.
    } else {
	set match [EvalAttached [list info vars $str*]]
	if {[llength $match] > 1} {
	    regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	    set match [linsert $match 0 $str]
	} else {
	    regsub -all { } $match {\\ } match
	}
    }
    return $match
}

# ::tk::console::ExpandBestMatch --
#
# Finds the best unique match in a list of names.
# The extra $e in this argument allows us to limit the innermost loop a little
# further.  This improves speed as $l becomes large or $e becomes long.
#
# Arguments:
#	l	- list to find best unique match in
# 	e	- currently best known unique match
#
# Returns:	longest unique match in the list

proc ::tk::console::ExpandBestMatch {l {e {}}} {
    set ec [lindex $l 0]
    if {[llength $l]>1} {
	set e [expr {[string length $e] - 1}]
	set ei [expr {[string length $ec] - 1}]
	foreach l $l {
	    while {$ei>=$e && [string first $ec $l]} {
		set ec [string range $ec 0 [incr ei -1]]
	    }
	}
    }
    return $ec
}

# now initialize the console
::tk::ConsoleInit
@


1.44
log
@Fix keyboard access to console menu and restored broken comment.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.43 2009/06/29 14:35:01 das Exp $
d350 33
d586 4
a589 26
    bind Console <<Cut>> {
        # Same as the copy event
 	if {![catch {set data [%W get sel.first sel.last]}]} {
	    clipboard clear -displayof %W
	    clipboard append -displayof %W $data
	}
    }
    bind Console <<Copy>> {
 	if {![catch {set data [%W get sel.first sel.last]}]} {
	    clipboard clear -displayof %W
	    clipboard append -displayof %W $data
	}
    }
    bind Console <<Paste>> {
	catch {
	    set clip [::tk::GetSelection %W CLIPBOARD]
	    set list [split $clip \n\r]
	    tk::ConsoleInsert %W [lindex $list 0]
	    foreach x [lrange $list 1 end] {
		%W mark set insert {end - 1c}
		tk::ConsoleInsert %W "\n"
		tk::ConsoleInvoke
		tk::ConsoleInsert %W $x
	    }
	}
    }
@


1.43
log
@Merge of TkAqua Cocoa port
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.42 2009/04/10 16:31:44 das Exp $
d376 2
a626 1
	break
@


1.42
log
@	* library/console.tcl (::tk::ConsoleInit): remove redundant TkAqua
	Quit menu item.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.41 2009/02/21 10:22:58 patthoyts Exp $
d120 5
@


1.41
log
@[Bug 2546087] Restore support for NULs in console stdout channel.
   In 2004 a fix to Tcl channels prevented the exposure of the
   internal UTF-8 representation of the ASCII NUL character
   (\uc080). Since then strings in the console have been truncated at
   NUL. This restores the older behaviour.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.40 2009/01/30 21:02:13 patthoyts Exp $
d71 1
a71 4
    if {[tk windowingsystem] eq "aqua"} {
	AmpMenuArgs .menubar.file add command \
		-label [mc &Quit] -command {exit} -accel "Cmd-Q"
    } else {
@


1.40
log
@catch font create when the console is re-sourced via F9
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.39 2008/12/10 05:02:51 das Exp $
d666 1
a666 1
    $w insert output $string $dest
@


1.39
log
@TIP #324 IMPLEMENTATION
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.38 2008/05/13 13:25:18 patthoyts Exp $
d126 1
a126 1
    font create TkConsoleFont {*}[font configure TkFixedFont]
@


1.38
log
@Support pixel sized font in the +/- keybindings
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.37 2007/12/13 15:26:27 dgp Exp $
d11 1
a11 1
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
d25 1
a25 1

a28 1

d100 18
d416 3
d580 3
d590 3
d698 29
@


1.37
log
@merge stable branch onto HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31.2.4 2007/11/12 19:22:38 dgp Exp $
d557 3
a559 1
        font configure TkConsoleFont -size [incr size]
d563 4
a566 1
        font configure TkConsoleFont -size [incr size -1]
@


1.37.2.1
log
@catch font create when the console is re-sourced via F9
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.37 2007/12/13 15:26:27 dgp Exp $
d109 1
a109 1
    catch {font create TkConsoleFont {*}[font configure TkFixedFont]}
@


1.37.2.2
log
@	* library/console.tcl (::tk::ConsoleInit): remove redundant TkAqua
	Quit menu item.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.37.2.1 2009/01/30 21:06:05 patthoyts Exp $
d72 4
a75 1
    if {[tk windowingsystem] ne "aqua"} {
@


1.37.2.3
log
@Backported fix for console keyboard menu activation and <<Cut>> handling.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.37.2.2 2009/04/10 16:29:18 das Exp $
a327 33
# Copy selected text from the console
proc ::tk::console::Copy {w} {
    if {![catch {set data [$w get sel.first sel.last]}]} {
        clipboard clear -displayof $w
        clipboard append -displayof $w $data
    }
}
# Copies selected text. If the selection is within the current active edit
# region then it will be cut, if not it is only copied.
proc ::tk::console::Cut {w} {
    if {![catch {set data [$w get sel.first sel.last]}]} {
        clipboard clear -displayof $w
        clipboard append -displayof $w $data
        if {[$w compare sel.first >= output]} {
            $w delete sel.first sel.last
	}
    }
}
# Paste text from the clipboard
proc ::tk::console::Paste {w} {
    catch {
        set clip [::tk::GetSelection $w CLIPBOARD]
        set list [split $clip \n\r]
        tk::ConsoleInsert $w [lindex $list 0]
        foreach x [lrange $list 1 end] {
            $w mark set insert {end - 1c}
            tk::ConsoleInsert $w "\n"
            tk::ConsoleInvoke
            tk::ConsoleInsert $w $x
        }
    }
}

a353 2
    # <Keypress> class binding will also fire and insert the character
    # which is wrong.
d526 26
a551 4
    bind Console <<Cut>> { ::tk::console::Cut %W }
    bind Console <<Copy>> { ::tk::console::Copy %W }
    bind Console <<Paste>> { ::tk::console::Paste %W }

d589 1
@


1.36
log
@	* macosx/tkMacOSXButton.c:	sync formatting, whitespace, copyright
	* macosx/tkMacOSXDialog.c:	with core-8-4-branch.
	* macosx/tkMacOSXMenus.c:
	* macosx/tkMacOSXWm.c:
	* xlib/xgc.c
	* library/bgerror.tcl:
	* library/console.tcl:
	* library/menu.tcl:
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.35 2007/11/04 10:38:29 das Exp $
@


1.35
log
@	* library/console.tcl:		add accelerators and fix Aqua bindings
					of the new font size menu items.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.34 2007/11/03 00:51:23 patthoyts Exp $
d11 1
@


1.34
log
@Add menu item and key binding to adjust font
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.33 2007/10/20 09:02:40 patthoyts Exp $
d100 4
a103 4
    AmpMenuArgs .menubar.edit add command -label [mc "&Increase font"] \
        -command {event generate .console <<Console_FontSizeIncr>>}
    AmpMenuArgs .menubar.edit add command -label [mc "&Reduce font"] \
        -command {event generate .console <<Console_FontSizeDecr>>}
d111 1
a111 1
        aqua { set preferred {Monaco 9} }
d390 9
a398 1

@


1.33
log
@On aqua, use tk scrollbar
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.32 2007/10/12 09:28:29 patthoyts Exp $
d99 6
d384 2
d546 8
@


1.32
log
@Make use of TkFixedFont and ttk widgets in the console. Try and select a better fixed font just for the console.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31 2006/01/25 18:22:04 dgp Exp $
d126 5
a130 1
    ::ttk::scrollbar .sb -command [list $con yview]
@


1.31
log
@        * library/bgerror.tcl:  Updates to use Tcl 8.4 features. [Patch 1237759]        * library/choosedir.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/focus.tcl:
        * library/msgbox.tcl:
        * library/palette.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.30 2005/11/30 01:24:48 hobbs Exp $
d101 29
a129 14
    set con [text .console -yscrollcommand [list .sb set] -setgrid true]
    scrollbar .sb -command [list $con yview]
    pack .sb -side right -fill both
    pack $con -fill both -expand 1 -side left
    switch -exact $tcl_platform(platform) {
	"windows" {
	    $con configure -font systemfixed
	}
	"unix" {
	    if {[tk windowingsystem] eq "aqua"} {
		$con configure -font {Monaco 9 normal} -highlightthickness 0
	    }
	}
    }
@


1.31.2.1
log
@merge updates from HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31 2006/01/25 18:22:04 dgp Exp $
d101 14
a114 29
    # See if we can find a better font than the TkFixedFont
    font create TkConsoleFont {*}[font configure TkFixedFont]
    set families [font families]
    switch -exact -- [tk windowingsystem] {
        aqua { set preferred {Monaco 9} }
        win32 { set preferred {ProFontWindows 8 Consolas 8} }
        default { set preferred {} }
    }
    foreach {family size} $preferred {
        if {[lsearch -exact $families $family] != -1} {
            font configure TkConsoleFont -family $family -size $size
            break
        }
    }

    # Provide the right border for the text widget (platform dependent).
    ::ttk::style layout ConsoleFrame {
        Entry.field -sticky news -border 1 -children {
            ConsoleFrame.padding -sticky news
        }
    }
    ::ttk::frame .consoleframe -style ConsoleFrame

    set con [text .console -yscrollcommand [list .sb set] -setgrid true \
                 -borderwidth 0 -highlightthickness 0 -font TkConsoleFont]
    ::ttk::scrollbar .sb -command [list $con yview]
    pack .sb  -in .consoleframe -fill both -side right -padx 1 -pady 1
    pack $con -in .consoleframe -fill both -expand 1 -side left -padx 1 -pady 1
    pack .consoleframe -fill both -expand 1 -side left
@


1.31.2.2
log
@merge updates from HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31.2.1 2007/10/15 18:38:34 dgp Exp $
d126 1
a126 5
    if {[tk windowingsystem] eq "aqua"} {
        scrollbar .sb -command [list $con yview]
    } else {
        ::ttk::scrollbar .sb -command [list $con yview]
    }
@


1.31.2.3
log
@merge updates from HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31.2.2 2007/10/24 12:59:33 dgp Exp $
a98 6
    AmpMenuArgs .menubar.edit add separator
    AmpMenuArgs .menubar.edit add command -label [mc "&Increase Font Size"] \
        -accel "$mod++" -command {event generate .console <<Console_FontSizeIncr>>}
    AmpMenuArgs .menubar.edit add command -label [mc "&Decrease Font Size"] \
        -accel "$mod+-" -command {event generate .console <<Console_FontSizeDecr>>}

d105 1
a105 1
        aqua { set preferred {Monaco 10} }
a377 2
        <<Console_FontSizeIncr>>	<Control-Key-plus>
        <<Console_FontSizeDecr>>	<Control-Key-minus>
d382 1
a382 9
    if {[tk windowingsystem] eq "aqua"} {
	foreach {ev key} {
	    <<Console_FontSizeIncr>>	<Command-Key-plus>
	    <<Console_FontSizeDecr>>	<Command-Key-minus>
	} {
	    event add $ev $key
	    bind Console $key {}
	}
    }
a537 8
    bind Console <<Console_FontSizeIncr>> {
        set size [font configure TkConsoleFont -size]
        font configure TkConsoleFont -size [incr size]
    }
    bind Console <<Console_FontSizeDecr>> {
        set size [font configure TkConsoleFont -size]
        font configure TkConsoleFont -size [incr size -1]
    }
@


1.31.2.4
log
@merge updates from HEAD
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.31.2.3 2007/11/05 14:24:18 dgp Exp $
a10 1
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
@


1.30
log
@	* library/console.tcl (::tk::ConsoleInit): improve work-around to
	avoid '% ' from tclMain.c [Bug 1252259]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.29 2005/07/25 09:06:01 dkf Exp $
d545 1
a545 1
	if {"%A" != ""} {
d638 1
a638 1
    if {$i == ""} {
d808 1
a808 1
    if {$tmp == ""} {
d830 1
a830 1
		if {![catch {Expand$t $str} res] && ($res != "")} {
@


1.29
log
@Apply some of the changes suggested in [Patch 1237759]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.28 2005/05/31 04:59:38 hobbs Exp $
d155 3
a157 1
	after idle [list $con delete 1.0 output]
@


1.28
log
@more elaborate variant to get first prompt displayed without a puts call
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.27 2005/05/30 23:41:01 hobbs Exp $
d86 1
a86 1
    if {[string compare $tcl_platform(platform) "windows"]} {
d172 1
a172 1
    if {[string compare $filename ""]} {
d193 1
a193 1
	while {[string compare [lindex $ranges $pos] ""]} {
d960 1
a960 1
    if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
@


1.27
log
@	* library/console.tcl (::tk::ConsoleInit): print out first prompt
	and swallow the extra "% " that comes once from Tcl on Windows.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.26 2004/11/17 22:16:44 hobbs Exp $
d140 13
a152 1
    ConsolePrompt
@


1.26
log
@	* library/console.tcl (::tk::console::ExpandVariable): correct
	array keyname expansion. [Bug 1004508] (bold)
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.25 2004/03/17 18:15:44 das Exp $
d139 6
@


1.25
log
@Removed support for Mac OS Classic platform [Patch 918139]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.24 2003/10/02 23:02:36 patthoyts Exp $
d951 1
a951 1
	} else {
@


1.24
log
@	* library/console.tcl: Avoid including the console in the list
	of interpreters exposed by [winfo interps].
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.23 2003/05/19 14:44:03 dkf Exp $
d52 1
a52 2
    if {$tcl_platform(platform) eq "macintosh"
	    || [tk windowingsystem] eq "aqua"} {
d71 1
a71 2
    if {$tcl_platform(platform) eq "macintosh" || \
	    [tk windowingsystem] eq "aqua"} {
a105 3
	"macintosh" {
	    $con configure -font {Monaco 9 normal} -highlightthickness 0
	}
d466 1
a466 7
	if {$tcl_platform(platform) eq "macintosh"} {
	    if {[catch {source [file join $tk_library console.tcl]}]} {
		source -rsrc console
	    }
	} else {
	    source [file join $tk_library console.tcl]
	}
d468 1
a468 2
    if {$::tcl_platform(platform) eq "macintosh" \
	    || [tk windowingsystem] eq "aqua"} {
@


1.23
log
@I18n (and some l10n) for the console and the main window of the widget demo.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22 2003/02/21 03:34:29 das Exp $
d133 3
@


1.22
log
@	* library/console.tcl: (aqua & macintosh) added missing <Cmd-q>
	binding for corresponding Quit menu item shortcut.

	* macosx/README: updated instructions for embedded build,
	added various improvements by Russell Owen.

	* unix/tcl.m4: update from Tcl.
	* unix/configure: regen.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d26 1
a26 1
    variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used
d52 2
a53 2
    if {[string equal $tcl_platform(platform) "macintosh"]
	    || [string equal [tk windowingsystem] "aqua"]} {
d59 5
a63 3
    if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
    .menubar add cascade -label File -menu .menubar.file -underline 0
    .menubar add cascade -label Edit -menu .menubar.edit -underline 0
d66 10
a75 10
    .menubar.file add command -label [mc "Source..."] \
	    -underline 0 -command tk::ConsoleSource
    .menubar.file add command -label [mc "Hide Console"] \
	    -underline 0 -command {wm withdraw .}
    .menubar.file add command -label [mc "Clear Console"] \
	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
   if {[string equal $tcl_platform(platform) "macintosh"]
	   || [string equal [tk windowingsystem] "aqua"]} {
	.menubar.file add command -label [mc "Quit"] \
		-command exit -accel Cmd-Q
d77 1
a77 2
	.menubar.file add command -label [mc "Exit"] \
		-underline 1 -command exit
d81 6
a86 6
    .menubar.edit add command -label [mc "Cut"] -underline 2 \
	    -command { event generate .console <<Cut>> } -accel "$mod+X"
    .menubar.edit add command -label [mc "Copy"] -underline 0 \
	    -command { event generate .console <<Copy>> } -accel "$mod+C"
    .menubar.edit add command -label [mc "Paste"] -underline 1 \
	    -command { event generate .console <<Paste>> } -accel "$mod+V"
d89 2
a90 2
	.menubar.edit add command -label [mc "Clear"] -underline 2 \
		-command { event generate .console <<Clear>> }
d92 4
a95 4
	.menubar.edit add command -label [mc "Delete"] -underline 0 \
		-command { event generate .console <<Clear>> } -accel "Del"
	
	.menubar add cascade -label Help -menu .menubar.help -underline 0
d97 2
a98 2
	.menubar.help add command -label [mc "About..."] \
		-underline 0 -command tk::ConsoleAbout
d103 1
a103 1
    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
d115 1
a115 1
	    if {[string equal [tk windowingsystem] "aqua"]} {
d184 1
a184 1
    if {[string equal $cmd ""]} {
d190 1
a190 1
	if {[string compare $result ""]} {
d239 1
a239 1
	    if {[string compare $cmd ""]} {
d261 1
a261 1
    if {[string equal $partial "normal"]} {
d299 3
a301 1
    foreach ev [bind Text] { bind Console $ev [bind Text $ev] }	
d347 3
a349 1
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
d352 3
a354 1
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
d357 3
a359 1
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
d362 3
a364 1
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
d373 1
a373 1
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
d382 1
a382 1
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
d406 3
a408 1
	if {[%W compare insert < promptEnd]} break
d412 3
a414 1
	if {[%W compare insert < promptEnd]} break
d468 4
a471 2
	if {[string equal $tcl_platform(platform) "macintosh"]} {
	    if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
d476 5
a480 5
    if {[string equal $::tcl_platform(platform) "macintosh"]
	   || [string equal [tk windowingsystem] "aqua"]} {
	    bind Console <Command-q> {
		exit
	    }
d513 1
a513 1
	if {[string compare \\ [%W get insert-2c]]} {
d518 1
a518 1
	if {[string compare \\ [%W get insert-2c]]} {
d523 1
a523 1
	if {[string compare \\ [%W get insert-2c]]} {
d528 1
a528 1
	if {[string compare \\ [%W get insert-2c]]} {
d552 1
a552 1
    if {[string equal $s ""]} {
d556 1
a556 1
	if {[$w compare sel.first <= insert]
d622 3
a624 1
    if {!$::tk::console::magicKeys} { return }
d627 5
a631 1
    if {$i == ""} {set i promptEnd} else {append i +2c}
d663 4
a666 2
    if {!$::tk::console::magicKeys} { return }
    if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
d669 1
a669 1
	    [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
d672 1
a672 1
	while {[string compare {} $ix]} {
d675 1
a675 1
	    while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
d677 3
a679 1
		if {[string match {\\} [$w get $i0-2c]]} continue
d682 3
a684 1
	    if {!$j} break
d686 4
a689 3
	    while {$j && [string compare {} \
		    [set ix [$w search -back $c1 $ix $lim]]]} {
		if {[string match {\\} [$w get $ix-1c]]} continue
d693 6
a698 2
	if {[string match {} $ix]} { set ix [$w index $lim] }
    } else { set ix [$w index $lim] }
d718 3
a720 1
    if {!$::tk::console::magicKeys} { return }
d723 7
a729 3
    while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
	if {[string match {\\} [$w get $i-1c]]} continue
	if {!$j} {set i0 $i}
d797 8
a804 2
    if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
    if {[$w compare $tmp >= insert]} { return }
d807 9
a815 3
	path* { set res [ExpandPathname $str] }
	proc* { set res [ExpandProcname $str] }
	var*  { set res [ExpandVariable $str] }
d819 3
a821 1
		if {![catch {Expand$t $str} res] && ($res != "")} { break }
d830 1
a830 2
	if {($len > 1) && $::tk::console::showMatches \
		&& [string equal $repl $str]} {
d833 3
a835 1
    } else { bell }
d860 3
a862 1
    if {[string match */ $str]} { append dir / }
d889 3
a891 1
	    if {[file isdir $match]} {append match /}
d956 3
a958 1
	    foreach var $match {lappend vars $ary\($var\)}
d960 3
a962 1
	} else {set match $ary\($match\)}
d991 2
a992 2
	set e  [string length $e]; incr e -1
	set ei [string length $ec]; incr ei -1
@


1.22.2.1
log
@	* library/console.tcl (::tk::console::ExpandVariable): correct
	array keyname expansion. [Bug 1004508] (bold)
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22 2003/02/21 03:34:29 das Exp $
d899 1
a899 3
	} elseif {[llength $match] == 1} {
	    set match $ary\($match\)
	}
@


1.22.2.2
log
@	* library/console.tcl (::tk::ConsoleInit): print out first prompt
	and swallow the extra "% " that comes once from Tcl on Windows.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.1 2004/11/17 22:18:28 hobbs Exp $
a139 6

    ConsolePrompt
    if {$tcl_platform(platform) eq "windows"} {
	# Subtle work-around to erase the '% ' that tclMain.c prints out
	after idle [list $con delete 1.0 output]
    }
@


1.22.2.3
log
@more elaborate variant of getting first prompt shown to avoid
a puts call.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.2 2005/05/30 23:40:33 hobbs Exp $
d141 1
a141 13
    # A variant of ConsolePrompt to avoid a 'puts' call
    set w $con
    set temp [$w index "end - 1 char"]
    $w mark set output end
    if {![consoleinterp eval "info exists tcl_prompt1"]} {
	set string [EvalAttached $::tk::console::defaultPrompt]
	$w insert output $string stdout
    }
    $w mark set output $temp
    ::tk::TextSetCursor $w end
    $w mark set promptEnd insert
    $w mark gravity promptEnd left

@


1.22.2.4
log
@	* library/console.tcl (::tk::ConsoleInit): improve work-around to
	avoid '% ' from tclMain.c [Bug 1252259]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.3 2005/05/31 04:58:00 hobbs Exp $
d156 1
a156 3
	after idle [subst -nocommand {
	    if {[$con get 1.0 output] eq "% "} { $con delete 1.0 output }
	}]
@


1.22.2.5
log
@        * library/bgerror.tcl:  Updates to use Tcl 8.4 features. [Patch 1237759]        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/palette.tcl:
        * library/panedwindow.tcl:
        * library/safetk.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.4 2005/11/30 01:22:55 hobbs Exp $
d52 2
a53 2
    if {$tcl_platform(platform) eq "macintosh"
	    || [tk windowingsystem] eq "aqua"} {
d70 2
a71 2
   if {$tcl_platform(platform) eq "macintosh"
	    || [tk windowingsystem] eq "aqua"} {
d87 1
a87 1
    if {$tcl_platform(platform) ne "windows"} {
d114 1
a114 1
	    if {[tk windowingsystem] eq "aqua"} {
d175 1
a175 1
    if {$filename ne ""} {
d196 1
a196 1
	while {[lindex $ranges $pos] ne ""} {
d203 1
a203 1
    if {$cmd eq ""} {
d209 1
a209 1
	if {$result ne ""} {
d258 1
a258 1
	    if {$cmd ne ""} {
d280 1
a280 1
    if {$partial eq "normal"} {
d382 2
a383 1
	if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} {
d391 2
a392 1
	if {[%W tag nextrange sel 1.0 end] ne "" && [%W compare sel.first >= promptEnd]} {
d473 1
a473 1
	if {$tcl_platform(platform) eq "macintosh"} {
d479 2
a480 1
    if {$::tcl_platform(platform) eq "macintosh" || [tk windowingsystem] eq "aqua"} {
d516 1
a516 1
	if {"\\" ne [%W get insert-2c]} {
d521 1
a521 1
	if {"\\" ne [%W get insert-2c]} {
d526 1
a526 1
	if {"\\" ne [%W get insert-2c]} {
d531 1
a531 1
	if {"\\" ne [%W get insert-2c]} {
d537 1
a537 1
	if {"%A" ne ""} {
d555 1
a555 1
    if {$s eq ""} {
d628 1
a628 1
    if {$i eq ""} {set i promptEnd} else {append i +2c}
d661 1
a661 1
    if {[set ix [$w search -back $c1 insert $lim]] ne ""} {
d664 1
a664 1
	    [set ix [$w search -back $c1 $ix-1c $lim]] ne ""
d667 1
a667 1
	while {$ix ne ""} {
d670 1
a670 1
	    while {[set i0 [$w search $c2 $i0 $i1]] ne ""} {
d677 2
a678 1
	    while {$j && [set ix [$w search -back $c1 $ix $lim]] ne ""} {
d707 1
a707 1
    while {[set i [$w search -back \" $i $lim]] ne ""} {
d777 1
a777 1
    if {$tmp eq ""} {set tmp promptEnd} else {append tmp +2c}
d787 1
a787 1
		if {![catch {Expand$t $str} res] && ($res ne "")} { break }
d796 2
a797 1
	if {($len > 1) && $::tk::console::showMatches && $repl eq $str} {
d962 1
a962 1
::tk::ConsoleInit 
@


1.22.2.6
log
@	Backport from HEAD of Aqua changes from 2007-10-12 to 2007-11-09
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.5 2006/01/25 18:21:41 dgp Exp $
a10 1
# Copyright (c) 2007 Daniel A. Steffen <das@@users.sourceforge.net>
d108 1
a108 1
	    $con configure -font {Monaco 10 normal} -highlightthickness 0
@


1.22.2.7
log
@	Backport from HEAD of Aqua changes from 2007-10-12 to 2007-11-09
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.22.2.6 2007/11/09 06:26:54 das Exp $
d116 1
a116 1
		$con configure -font {Monaco 10 normal} -highlightthickness 0
@


1.21
log
@	*** macosx-8-4-branch merged into the mainline [tcl patch #602770] ***

	* generic/tk.decls:
	* generic/tkInt.decls: added new "aqua" specific entries to the
	stubs tables. Changed all "unix" entries to "x11" to allow us to
	distinguish and build both "aqua" on MacOSX and "x11" on MacOSX.

	* generic/tk.h: added a #ifnded RESOURCE_INCLUDED so that tk.h can
	be passed to the resource compiler.

	* generic/tkCmds.c (Tk_TkObjCmd): added [tk windowingsystem]
	subcommand: returns "x11" when running on X11, "win32" on Windows,
	"classic" on MacOS9 and "aqua" on MacOSX Aqua (i.e. Carbon)

	* generic/tkFont.c (TkFontGetFirstTextLayout): new private function
	returning the first chunk of a Tk_TextLayout, i.e. until the first
	font change on the first line (or the whole first line if there is
	no such font change).

	* generic/tkMain.c: made Tcl_ThreadDataKey static

	* library/demos/puzzle.tcl: fixed button metrics for aqua

	* tests/cursor.test: check for presence of arrow cursor instead of
	heart cursor

	* xlib/xcolors.c: changed xColors static initialization to more
	standard C

	* macosx/Wish.pbproj/jingham.pbxuser (new):
	* macosx/Wish.pbproj/project.pbxproj (new): project for Apple's
	ProjectBuilder IDE.

	* macosx/Makefile (new): simple makefile for building the project
	from the command line via the ProjectBuilder tool 'pbxbuild'.

	* macosx/tkMacOSXAppInit.c (new): macosx specific AppInit looking
	for a AppMain.tcl file in its bundled Resources/Scripts folder. If
	present, argv[1] is set to that file and the Scripts folder is
	added to the auto_path. This allows tk apps to embed scripts within
	their bundle directory structure.

	* macosx/tkMacOSXInit.c (new): macosx adapted version of
	tkUnixInit.c: we initialize & cache the Carbon native encoding
	(e.g. 'macRoman') and try to find the tk script library files
	inside Tk packaged as a framework.

	* macosx/tkMacOSXNotify.c (new): new macosx specific merged
	Carbon/select-based notifier.

	* macosx/tkMacOSXEvent.c (new):
	* macosx/tkMacOSXEvent.h (new):
	* macosx/tkMacOSXKeyEvent.c (new):
	* macosx/tkMacOSXMouseEvent.c (new):
	* macosx/tkMacOSXWindowEvent.c (new): new macosx specific event
	handling functionality.

	* macosx/tkMacOSX.h (new):
	* macosx/tkMacOSXBitmap.c (new):
	* macosx/tkMacOSXButton.c (new):
	* macosx/tkMacOSXClipboard.c (new):
	* macosx/tkMacOSXColor.c (new):
	* macosx/tkMacOSXConfig.c (new):
	* macosx/tkMacOSXCursor.c (new):
	* macosx/tkMacOSXDefault.h (new):
	* macosx/tkMacOSXDialog.c (new):
	* macosx/tkMacOSXDraw.c (new):
	* macosx/tkMacOSXEmbed.c (new):
	* macosx/tkMacOSXFont.c (new):
	* macosx/tkMacOSXHLEvents.c (new):
	* macosx/tkMacOSXInt.h (new):
	* macosx/tkMacOSXKeyboard.c (new):
	* macosx/tkMacOSXMenu.c (new):
	* macosx/tkMacOSXMenubutton.c (new):
	* macosx/tkMacOSXMenus.c (new):
	* macosx/tkMacOSXPort.h (new):
	* macosx/tkMacOSXRegion.c (new):
	* macosx/tkMacOSXScale.c (new):
	* macosx/tkMacOSXScrlbr.c (new):
	* macosx/tkMacOSXSubwindows.c (new):
	* macosx/tkMacOSXTest.c (new):
	* macosx/tkMacOSXUtil.c (new):
	* macosx/tkMacOSXUtil.h (new):
	* macosx/tkMacOSXWm.c (new):
	* macosx/tkMacOSXWm.h (new):
	* macosx/tkMacOSXXStubs.c (new): macosx ports of classic mac Tk
	implementation in tk/mac.

	* macosx/tkMacOSXSend.c (new): only send to local interp
	implemented currently.

	* macosx/tkMacOSXDebug.h (new):
	* macosx/tkMacOSXDebug.c (new): new macosx specific functions for
	debugging MacOS events, regions, etc.

	* macosx/tkAboutDlg.r (new):
	* macosx/tkMacOSXApplication.r (new):
	* macosx/tkMacOSXCursors.r (new):
	* macosx/tkMacOSXLibrary.r (new):
	* macosx/tkMacOSXMenu.r (new):
	* macosx/tkMacOSXResource.r (new):
	* macosx/tkMacOSXXCursors.r (new):
	* macosx/tclets.r (new): sources for Rez resource compiler.

	* macosx/Wish.icns (new): Wish application icon.

	* generic/tk.h:
	* generic/default.h:
	* generic/tkBind.c:
	* generic/tkCmds.c:
	* generic/tkGrab.c:
	* generic/tkPointer.c:
	* generic/tkPort.h:
	* generic/tkSelect.c:
	* generic/tkStubLib.c:
	* generic/tkTest.c:
	* generic/tkText.c:
	* generic/tkWindow.c:
	* unix/tkUnix3d.c:
	* xlib/xgc.c:
	* xlib/X11/X.h:
	* xlib/X11/Xlib.h:
	* xlib/X11/Xutil.h: added #includes and #ifdefs for macosx

	* library/bgerror.tcl:
	* library/button.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/scrlbar.tcl:
	* library/spinbox.tcl:
	* library/text.tcl:
	* library/tk.tcl:
	* library/demos/menu.tcl:
	* library/demos/menubu.tcl:
	* library/demos/widget: check [tk windowingsystem] instead of
	and/or in addition to $tcl_platform(platform).

	* generic/tkInt.h:
	* mac/tkMacBitmap.c:
	* mac/tkMacWm.c: added missing CONSTification

	* generic/tkIntDecls.h:
	* generic/tkIntPlatDecls.h:
	* generic/tkIntXlibDecls.h:
	* generic/tkPlatDecls.h:
	* generic/tkStubInit.c: regen
@
text
@d459 6
@


1.20
log
@	* library/console.tcl: corrected the defaultPrompt substitution
	[Bug #553207] and made Tab a default expansion key (like Escape).
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.19 2002/05/20 10:21:23 das Exp $
d52 4
a55 1
    if {[string compare $tcl_platform(platform) "macintosh"]} {
a56 2
    } else {
	set mod "Cmd"
d70 5
a74 1
    if {[string compare $tcl_platform(platform) "macintosh"]} {
a76 3
    } else {
	.menubar.file add command -label [mc "Quit"] \
		-command exit -accel Cmd-Q
d112 5
@


1.19
log
@	* mac/tkMacInit.c:
	* library/console.tcl:
	* library/tk.tcl: fix tk.tcl not sourcing library files
	that define bindings at startup on mac. (independent of
	tk library files being in resources or on auto_path)
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.18 2002/04/29 13:17:44 bagnonm Exp $
d28 1
d30 1
a30 1
	set defaultPrompt {subst "[history nextid] % "}
d32 1
a32 1
	set defaultPrompt {subst "([file tail [pwd]]) [history nextid] % "}
d316 1
a335 5
    bind Console <Tab> {
	tk::ConsoleInsert %W \t
	focus %W
	break
    }
@


1.18
log
@new feature, make dependence on msgcat soft, [539309]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.17 2002/03/01 00:04:27 dgp Exp $
d450 1
a450 1
	    if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}
@


1.17
log
@        * library/console.tcl (ConsoleBind): Corrected console <<Paste>>
        binding on Unix platforms.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.16 2001/11/23 02:04:17 das Exp $
a16 1
package require msgcat
d62 1
a62 1
    .menubar.file add command -label [::msgcat::mc "Source..."] \
d64 1
a64 1
    .menubar.file add command -label [::msgcat::mc "Hide Console"] \
d66 1
a66 1
    .menubar.file add command -label [::msgcat::mc "Clear Console"] \
d69 1
a69 1
	.menubar.file add command -label [::msgcat::mc "Exit"] \
d72 1
a72 1
	.menubar.file add command -label [::msgcat::mc "Quit"] \
d77 1
a77 1
    .menubar.edit add command -label [::msgcat::mc "Cut"] -underline 2 \
d79 1
a79 1
    .menubar.edit add command -label [::msgcat::mc "Copy"] -underline 0 \
d81 1
a81 1
    .menubar.edit add command -label [::msgcat::mc "Paste"] -underline 1 \
d85 1
a85 1
	.menubar.edit add command -label [::msgcat::mc "Clear"] -underline 2 \
d88 1
a88 1
	.menubar.edit add command -label [::msgcat::mc "Delete"] -underline 0 \
d93 1
a93 1
	.menubar.help add command -label [::msgcat::mc "About..."] \
d126 1
a126 1
    wm title . [::msgcat::mc "Console"]
d143 1
a143 1
	    -title [::msgcat::mc "Select a file to source"] \
d145 2
a146 2
	    [list [::msgcat::mc "Tcl Scripts"] .tcl] \
	    [list [::msgcat::mc "All Files"] *]]]
d579 1
a579 1
    tk_messageBox -type ok -message "[::msgcat::mc {Tcl for Windows}]
@


1.16
log
@	**  upport to 8.4 of mac code changes for 8.3.3 & various new
	**  changes for 8.4, some already backported to 8.3.4 (patch #435660)

	see ChangeLog for details
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.15 2001/10/19 17:43:52 hobbs Exp $
d292 1
a292 1
    ## We really didn't want the newline insertion
d294 2
@


1.15
log
@	* library/console.tcl: removed transpose ability until the console
	can get a proper rewrite of tag handling.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.14 2001/10/18 20:26:42 hobbs Exp $
d449 1
a449 1
	    source -rsrc Console
@


1.14
log
@	* library/console.tcl (ConsoleOutput): fixed undefined widget
	argument.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.13 2001/10/09 23:11:02 hobbs Exp $
d295 4
a399 4
    }
    bind Console <<Console_Transpose>> {
	## Transpose current and previous chars
	if {[%W compare insert > promptEnd]} { ::tk::TextTranspose %W }
@


1.13
log
@	* library/console.tcl:  added more smarts extracted from tkcon to
	the default console.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.12 2001/08/01 16:21:11 dgp Exp $
d551 2
a552 1
    .console insert output $string $dest
d554 1
a554 1
    .console see insert
@


1.13.2.1
log
@First checkin of support for Tk on Mac OS X.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
a44 2
package require msgcat

d52 3
a54 2
    if {[string equal $tcl_platform(platform) "macintosh"]
            || [string equal $tcl_platform(windowingsystem) "aqua"]} {
a55 2
    } else {
	set mod "Ctrl"
d66 1
a66 1
	    -underline 0  -command {wm withdraw .}
d69 4
a72 2
   if {[string equal $tcl_platform(platform) "macintosh"]
           || [string equal $tcl_platform(windowingsystem) "aqua"]} {
a74 3
    } else {
	.menubar.file add command -label [::msgcat::mc "Exit"] \
		-underline 1 -command exit
a110 5
        "unix" {
            if {[string equal $tcl_platform(windowingsystem) "aqua"]} {
	        $con configure -font {Monaco 9 normal} -highlightthickness 0
            }
        }
@


1.13.2.2
log
@Merge with current TOT
Added support for the wm stackorder command
Fixed crash when selecting Menu items in the Application menu that we didn't
put there.
Added first bits of the use of CG for low-level drawing.  The line-drawing works,
the rest doesn't yet.  You have to set the file static useCGDrawing to 1 and
rebuild to activate this code.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.13.2.1 2001/10/15 09:22:00 wolfsuit Exp $
a303 4
    # For the moment, transpose isn't enabled until the console
    # gets and overhaul of how it handles input -- hobbs
    bind Console <Control-Key-t> {}

d406 4
d458 1
a458 1
	    if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}
d560 1
a560 2
    set w .console
    $w insert output $string $dest
d562 1
a562 1
    $w see insert
@


1.13.2.3
log
@Merging with TOT as of 06/09/2002.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d45 2
d66 1
a66 1
    .menubar.file add command -label [mc "Source..."] \
d68 1
a68 1
    .menubar.file add command -label [mc "Hide Console"] \
d70 1
a70 1
    .menubar.file add command -label [mc "Clear Console"] \
d74 1
a74 1
	.menubar.file add command -label [mc "Quit"] \
d77 1
a77 1
	.menubar.file add command -label [mc "Exit"] \
d82 1
a82 1
    .menubar.edit add command -label [mc "Cut"] -underline 2 \
d84 1
a84 1
    .menubar.edit add command -label [mc "Copy"] -underline 0 \
d86 1
a86 1
    .menubar.edit add command -label [mc "Paste"] -underline 1 \
d90 1
a90 1
	.menubar.edit add command -label [mc "Clear"] -underline 2 \
d93 1
a93 1
	.menubar.edit add command -label [mc "Delete"] -underline 0 \
d98 1
a98 1
	.menubar.help add command -label [mc "About..."] \
d115 2
a116 2
	"unix" {
	    if {[string equal $tcl_platform(windowingsystem) "aqua"]} {
d118 2
a119 2
	    }
	}
d136 1
a136 1
    wm title . [mc "Console"]
d153 1
a153 1
	    -title [mc "Select a file to source"] \
d155 2
a156 2
	    [list [mc "Tcl Scripts"] .tcl] \
	    [list [mc "All Files"] *]]]
d301 1
a301 1
    ## We really didn't want the newline insertion...
a302 2
    ## ...or any Control-v binding (would block <<Paste>>)
    bind Console <Control-Key-v> {}
d458 1
a458 1
	    if {[catch {source [file join $tk_library console.tcl]}]} {source -rsrc console}
d587 1
a587 1
    tk_messageBox -type ok -message "[mc {Tcl for Windows}]
@


1.13.2.4
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d17 1
a28 1

d30 1
a30 1
	set defaultPrompt {subst {[history nextid] % }}
d32 1
a32 1
	set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
d67 1
a67 1
	    -underline 0 -command {wm withdraw .}
a322 1
	<<Console_Expand>>		<Key-Tab>
d342 5
@


1.13.2.5
log
@whitespace & other cleanup
wish startup code cleanup induced by new support in tcl for standard MacOSX tcl package locations
renamed Tk_GetFirstTextLayout to private TkFontGetFirstTextLayout
@
text
@d53 1
a53 1
	    || [string equal $tcl_platform(windowingsystem) "aqua"]} {
d71 1
a71 1
	   || [string equal $tcl_platform(windowingsystem) "aqua"]} {
d115 1
a115 1
		$con configure -font {Monaco 9 normal} -highlightthickness 0
@


1.13.2.6
log
@various project cleanups & enhancements
added macosx/Makefile to facilitate building from cli
added [tk windowingsystem] and removed $::tcl_plaform(windowingsystem)
changed all runtime library references to the above
removed duplicate entries in tk.decls & tkInt.decls
CONSTification and other small changes in macosx/ to remove compiler warnings
@
text
@d53 1
a53 1
	    || [string equal [tk windowingsystem] "aqua"]} {
d71 1
a71 1
	   || [string equal [tk windowingsystem] "aqua"]} {
d114 1
a114 1
	    if {[string equal [tk windowingsystem] "aqua"]} {
@


1.12
log
@	Merged changes from feature branch dgp-privates-into-namespace,
	implementing TIP 44.  All Tk commands and variables matching
	tk[A-Z]* are now in the ::tk namespace.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.11 2001/07/03 01:03:16 hobbs Exp $
d17 21
d58 1
a58 1
    menu .menubar
d66 3
a68 1
	    -underline 0  -command {wm withdraw .}
d100 2
a101 2
    text .console  -yscrollcommand ".sb set" -setgrid true 
    scrollbar .sb -command ".console yview"
d103 1
a103 1
    pack .console -fill both -expand 1 -side left
d106 1
a106 1
	    .console configure -font {Monaco 9 normal} -highlightthickness 0
d109 1
a109 1
	    .console configure -font systemfixed
d113 10
a122 1
    ConsoleBind .console
d124 1
a124 2
    .console tag configure stderr -foreground red
    .console tag configure stdin -foreground blue
a125 2
    focus .console
    
d129 4
a132 4
    .console mark set output [.console index "end - 1 char"]
    tk::TextSetCursor .console end
    .console mark set promptEnd insert
    .console mark gravity promptEnd left
d144 4
a147 4
		      -title [::msgcat::mc "Select a file to source"] \
		      -filetypes [list \
			  [list [::msgcat::mc "Tcl Scripts"] .tcl] \
			  [list [::msgcat::mc "All Files"] *]]]
d205 1
a205 1
    
d252 1
d254 2
a255 2
	set temp [.console index "end - 1 char"]
	.console mark set output end
d259 1
a259 1
    	    puts -nonewline "% "
d262 2
a263 2
	set temp [.console index output]
	.console mark set output end
d271 6
a276 4
    .console mark set output $temp
    ::tk::TextSetCursor .console end
    .console mark set promptEnd insert
    .console mark gravity promptEnd left
d287 7
a293 2
proc ::tk::ConsoleBind {win} {
    bindtags $win "$win Text . all"
a296 2
    # <KeyPress> class binding will also fire and insert the character,
    # which is wrong.  Ditto for <Escape>.
d298 30
a327 5
    bind $win <Alt-KeyPress> {# nothing }
    bind $win <Meta-KeyPress> {# nothing}
    bind $win <Control-KeyPress> {# nothing}
    bind $win <Escape> {# nothing}
    bind $win <KP_Enter> {# nothing}
d329 1
a329 1
    bind $win <Tab> {
d334 13
a346 1
    bind $win <Return> {
d352 17
a368 22
    bind $win <Delete> {
	if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	    %W tag remove sel sel.first promptEnd
	} elseif {[%W compare insert < promptEnd]} {
	    break
	}
    }
    bind $win <BackSpace> {
	if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
	    %W tag remove sel sel.first promptEnd
	} elseif {[%W compare insert <= promptEnd]} {
	    break
	}
    }
    foreach left {Control-a Home} {
	bind $win <$left> {
	    if {[%W compare insert < promptEnd]} {
		tk::TextSetCursor %W {insert linestart}
	    } else {
		tk::TextSetCursor %W promptEnd
            }
	    break
d371 7
a377 4
    foreach right {Control-e End} {
	bind $win <$right> {
	    tk::TextSetCursor %W {insert lineend}
	    break
d380 15
a394 3
    bind $win <Control-d> {
	if {[%W compare insert < promptEnd]} {
	    break
d397 15
a411 3
    bind $win <Control-k> {
	if {[%W compare insert < promptEnd]} {
	    %W mark set insert promptEnd
d414 3
a416 3
    bind $win <Control-t> {
	if {[%W compare insert < promptEnd]} {
	    break
d419 3
a421 3
    bind $win <Meta-d> {
	if {[%W compare insert < promptEnd]} {
	    break
d424 3
a426 3
    bind $win <Meta-BackSpace> {
	if {[%W compare insert <= promptEnd]} {
	    break
d429 3
a431 3
    bind $win <Control-h> {
	if {[%W compare insert <= promptEnd]} {
	    break
d434 2
a435 5
    foreach prev {Control-p Up} {
	bind $win <$prev> {
	    tk::ConsoleHistory prev
	    break
	}
d437 2
a438 5
    foreach prev {Control-n Down} {
	bind $win <$prev> {
	    tk::ConsoleHistory next
	    break
	}
d440 1
a440 1
    bind $win <Insert> {
a441 1
	break
d443 1
a443 1
    bind $win <KeyPress> {
a444 1
	break
d446 1
a446 16
    foreach left {Control-b Left} {
	bind $win <$left> {
	    if {[%W compare insert == promptEnd]} {
		break
	    }
	    tk::TextSetCursor %W insert-1c
	    break
	}
    }
    foreach right {Control-f Right} {
	bind $win <$right> {
	    tk::TextSetCursor %W insert+1c
	    break
	}
    }
    bind $win <F9> {
d454 1
a454 1
    bind $win <<Cut>> {
a459 1
	break
d461 1
a461 1
    bind $win <<Copy>> {
a465 1
	break
d467 1
a467 1
    bind $win <<Paste>> {
d479 30
d535 1
a535 1
	$w mark set insert end	
d552 1
a576 1
    global tk_patchLevel
a577 1
Copyright \251 2000 Ajuba Solutions
d579 346
a924 2
Tcl [info patchlevel]
Tk $tk_patchLevel"
a927 1

@


1.11
log
@	* library/console.tcl:
	* library/entry.tcl:
	* library/spinbox.tcl:
	* library/text.tcl:
	* library/tk.tcl: added private ::tk::GetSelection command to
	handle requesting selection.  This is to support requesting
	UTF8_STRING before generic STRING on Unix.  Changed Text, Spinbox,
	Entry and Console to use this command.

	* tests/select.test:
	* generic/tkSelect.c (Tk_CreateSelHandler, Tk_DeleteSelHandler):
	on Unix, a UTF8_STRING handler will be created when the user
	requests a STRING handler (in addition to the STRING handler).
	This provides implicit support for the new UTF8_STRING selection
	target.
	* unix/tkUnixSelect.c (TkSelEventProc, ConvertSelection): Added
	support for UTF8_STRING target. [RFE #418653, Patch #433283]

	* generic/tkInt.h: added utf8Atom to TkDisplay structure.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.10 2000/11/02 22:55:16 hobbs Exp $
d18 1
a18 1
# tkConsoleInit --
d24 1
a24 1
proc tkConsoleInit {} {
d43 1
a43 1
	    -underline 0 -command tkConsoleSource
d72 1
a72 1
		-underline 0 -command tkConsoleAbout
d90 1
a90 1
    tkConsoleBind .console
d101 1
a101 1
    tkTextSetCursor .console end
d106 1
a106 1
# tkConsoleSource --
d113 1
a113 1
proc tkConsoleSource {} {
d122 1
a122 1
	    tkConsoleOutput stderr "$result\n"
d127 1
a127 1
# tkConsoleInvoke --
d135 1
a135 1
proc tkConsoleInvoke {args} {
d148 1
a148 1
	tkConsolePrompt
d156 2
a157 2
	tkConsoleHistory reset
	tkConsolePrompt
d159 1
a159 1
	tkConsolePrompt partial
d164 1
a164 1
# tkConsoleHistory --
d167 2
a168 2
# main interpreter to obtain the history.  The global variable
# histNum is used to store the current location in the history.
d173 3
a175 3
set histNum 1
proc tkConsoleHistory {cmd} {
    global histNum
d179 2
a180 2
	    incr histNum -1
	    if {$histNum == 0} {
d183 1
a183 1
		set cmd "history event $histNum"
d186 1
a186 1
    	    	incr histNum
d193 2
a194 2
	    incr histNum
	    if {$histNum == 0} {
d196 1
a196 1
	    } elseif {$histNum > 0} {
d198 1
a198 1
		set histNum 1
d200 1
a200 1
		set cmd "history event $histNum"
d209 1
a209 1
    	    set histNum 1
d214 1
a214 1
# tkConsolePrompt --
d222 1
a222 1
proc tkConsolePrompt {{partial normal}} {
d242 1
a242 1
    tkTextSetCursor .console end
d247 1
a247 1
# tkConsoleBind --
d255 1
a255 1
proc tkConsoleBind {win} {
d270 1
a270 1
	tkConsoleInsert %W \t
d276 2
a277 2
	tkConsoleInsert %W "\n"
	tkConsoleInvoke
d297 1
a297 1
		tkTextSetCursor %W {insert linestart}
d299 1
a299 1
		tkTextSetCursor %W promptEnd
d306 1
a306 1
	    tkTextSetCursor %W {insert lineend}
d342 1
a342 1
	    tkConsoleHistory prev
d348 1
a348 1
	    tkConsoleHistory next
d353 1
a353 1
	catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
d357 1
a357 1
	tkConsoleInsert %W %A
d365 1
a365 1
	    tkTextSetCursor %W insert-1c
d371 1
a371 1
	    tkTextSetCursor %W insert+1c
d402 1
a402 1
	    tkConsoleInsert %W [lindex $list 0]
d405 3
a407 3
		tkConsoleInsert %W "\n"
		tkConsoleInvoke
		tkConsoleInsert %W $x
d414 1
a414 1
# tkConsoleInsert --
d424 1
a424 1
proc tkConsoleInsert {w s} {
d442 1
a442 1
# tkConsoleOutput --
d451 1
a451 1
proc tkConsoleOutput {dest string} {
d456 1
a456 1
# tkConsoleExit --
d465 1
a465 1
proc tkConsoleExit {} {
d469 1
a469 1
# tkConsoleAbout --
d476 1
a476 1
proc tkConsoleAbout {} {
d487 1
a487 1
tkConsoleInit
@


1.10
log
@updated copyright
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.9 2000/06/30 06:38:38 ericm Exp $
d353 1
a353 1
	catch {tkConsoleInsert %W [selection get -displayof %W]}
d400 1
a400 1
	    set clip [selection get -displayof %W -selection CLIPBOARD]
@


1.10.2.1
log
@update to head
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.17 2002/03/01 00:04:27 dgp Exp $
a16 1
package require msgcat
d18 1
a18 21
namespace eval ::tk::console {
    variable blinkTime   500 ; # msecs to blink braced range for
    variable blinkRange  1   ; # enable blinking of the entire braced range
    variable magicKeys   1   ; # enable brace matching and proc/var recognition
    variable maxLines    600 ; # maximum # of lines buffered in console
    variable showMatches 1   ; # show multiple expand matches

    variable inPlugin [info exists embed_args]
    variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used

    if {$inPlugin} {
	set defaultPrompt {subst "[history nextid] % "}
    } else {
	set defaultPrompt {subst "([file tail [pwd]]) [history nextid] % "}
    }
}

# simple compat function for tkcon code added for this console
interp alias {} EvalAttached {} consoleinterp eval

# ::tk::ConsoleInit --
d24 1
a24 1
proc ::tk::ConsoleInit {} {
d37 1
a37 1
    if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
d43 1
a43 1
	    -underline 0 -command tk::ConsoleSource
d45 1
a45 3
	    -underline 0 -command {wm withdraw .}
    .menubar.file add command -label [::msgcat::mc "Clear Console"] \
	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
d72 1
a72 1
		-underline 0 -command tk::ConsoleAbout
d77 2
a78 2
    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
    scrollbar .sb -command [list $con yview]
d80 1
a80 1
    pack $con -fill both -expand 1 -side left
d83 1
a83 1
	    $con configure -font {Monaco 9 normal} -highlightthickness 0
d86 1
a86 1
	    $con configure -font systemfixed
d90 1
a90 10
    ConsoleBind $con

    $con tag configure stderr	-foreground red
    $con tag configure stdin	-foreground blue
    $con tag configure prompt	-foreground \#8F4433
    $con tag configure proc	-foreground \#008800
    $con tag configure var	-background \#FFC0D0
    $con tag raise sel
    $con tag configure blink	-background \#FFFF00
    $con tag configure find	-background \#FFFF00
d92 2
a93 1
    focus $con
d95 2
d100 4
a103 4
    $con mark set output [$con index "end - 1 char"]
    tk::TextSetCursor $con end
    $con mark set promptEnd insert
    $con mark gravity promptEnd left
d106 1
a106 1
# ::tk::ConsoleSource --
d113 1
a113 1
proc ::tk::ConsoleSource {} {
d115 4
a118 4
	    -title [::msgcat::mc "Select a file to source"] \
	    -filetypes [list \
	    [list [::msgcat::mc "Tcl Scripts"] .tcl] \
	    [list [::msgcat::mc "All Files"] *]]]
d122 1
a122 1
	    ConsoleOutput stderr "$result\n"
d127 1
a127 1
# ::tk::ConsoleInvoke --
d135 1
a135 1
proc ::tk::ConsoleInvoke {args} {
d148 1
a148 1
	ConsolePrompt
d156 2
a157 2
	ConsoleHistory reset
	ConsolePrompt
d159 1
a159 1
	ConsolePrompt partial
d164 1
a164 1
# ::tk::ConsoleHistory --
d167 2
a168 2
# main interpreter to obtain the history.  The variable
# ::tk::HistNum is used to store the current location in the history.
d173 4
a176 4
set ::tk::HistNum 1
proc ::tk::ConsoleHistory {cmd} {
    variable HistNum

d179 2
a180 2
	    incr HistNum -1
	    if {$HistNum == 0} {
d183 1
a183 1
		set cmd "history event $HistNum"
d186 1
a186 1
    	    	incr HistNum
d193 2
a194 2
	    incr HistNum
	    if {$HistNum == 0} {
d196 1
a196 1
	    } elseif {$HistNum > 0} {
d198 1
a198 1
		set HistNum 1
d200 1
a200 1
		set cmd "history event $HistNum"
d209 1
a209 1
    	    set HistNum 1
d214 1
a214 1
# ::tk::ConsolePrompt --
d222 1
a222 2
proc ::tk::ConsolePrompt {{partial normal}} {
    set w .console
d224 2
a225 2
	set temp [$w index "end - 1 char"]
	$w mark set output end
d229 1
a229 1
    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
d232 2
a233 2
	set temp [$w index output]
	$w mark set output end
d241 4
a244 6
    $w mark set output $temp
    ::tk::TextSetCursor $w end
    $w mark set promptEnd insert
    $w mark gravity promptEnd left
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
    $w see end
d247 1
a247 1
# ::tk::ConsoleBind --
d255 2
a256 13
proc ::tk::ConsoleBind {w} {
    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]

    ## Get all Text bindings into Console
    foreach ev [bind Text] { bind Console $ev [bind Text $ev] }	
    ## We really didn't want the newline insertion...
    bind Console <Control-Key-o> {}
    ## ...or any Control-v binding (would block <<Paste>>)
    bind Console <Control-Key-v> {}

    # For the moment, transpose isn't enabled until the console
    # gets and overhaul of how it handles input -- hobbs
    bind Console <Control-Key-t> {}
d260 2
d263 5
a267 30
    bind Console <Alt-KeyPress> {# nothing }
    bind Console <Meta-KeyPress> {# nothing}
    bind Console <Control-KeyPress> {# nothing}

    foreach {ev key} {
	<<Console_Prev>>		<Key-Up>
	<<Console_Next>>		<Key-Down>
	<<Console_NextImmediate>>	<Control-Key-n>
	<<Console_PrevImmediate>>	<Control-Key-p>
	<<Console_PrevSearch>>		<Control-Key-r>
	<<Console_NextSearch>>		<Control-Key-s>

	<<Console_Expand>>		<Key-Escape>
	<<Console_ExpandFile>>		<Control-Shift-Key-F>
	<<Console_ExpandProc>>		<Control-Shift-Key-P>
	<<Console_ExpandVar>>		<Control-Shift-Key-V>
	<<Console_Tab>>			<Control-Key-i>
	<<Console_Tab>>			<Meta-Key-i>
	<<Console_Eval>>		<Key-Return>
	<<Console_Eval>>		<Key-KP_Enter>

	<<Console_Clear>>		<Control-Key-l>
	<<Console_KillLine>>		<Control-Key-k>
	<<Console_Transpose>>		<Control-Key-t>
	<<Console_ClearLine>>		<Control-Key-u>
	<<Console_SaveCommand>>		<Control-Key-z>
    } {
	event add $ev $key
	bind Console $key {}
    }
d269 2
a270 2
    bind Console <Tab> {
	tk::ConsoleInsert %W \t
d274 1
a274 13
    bind Console <<Console_Expand>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
    }
    bind Console <<Console_ExpandFile>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
    }
    bind Console <<Console_ExpandProc>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
    }
    bind Console <<Console_ExpandVar>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
    }
    bind Console <<Console_Eval>> {
d276 2
a277 2
	tk::ConsoleInsert %W "\n"
	tk::ConsoleInvoke
d280 28
a307 17
    bind Console <Delete> {
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert >= promptEnd]} {
	    %W delete insert
	    %W see insert
	}
    }
    bind Console <BackSpace> {
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert != 1.0] && \
		[%W compare insert > promptEnd]} {
	    %W delete insert-1c
	    %W see insert
d310 1
a310 3
    bind Console <Control-h> [bind Console <BackSpace>]

    bind Console <Home> {
d312 1
a312 3
	    tk::TextSetCursor %W {insert linestart}
	} else {
	    tk::TextSetCursor %W promptEnd
d315 3
a317 15
    bind Console <Control-a> [bind Console <Home>]
    bind Console <End> {
	tk::TextSetCursor %W {insert lineend}
    }
    bind Console <Control-e> [bind Console <End>]
    bind Console <Control-d> {
	if {[%W compare insert < promptEnd]} break
	%W delete insert
    }
    bind Console <<Console_KillLine>> {
	if {[%W compare insert < promptEnd]} break
	if {[%W compare insert == {insert lineend}]} {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
d320 4
a323 3
    bind Console <<Console_Clear>> {
	## Clear console display
	%W delete 1.0 "promptEnd linestart"
d325 3
a327 7
    bind Console <<Console_ClearLine>> {
	## Clear command line (Unix shell staple)
	%W delete promptEnd end
    }
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d330 3
a332 3
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
d335 3
a337 3
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d340 4
a343 3
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
d346 4
a349 3
    bind Console <Meta-Delete> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d352 3
a354 2
    bind Console <<Console_Prev>> {
	tk::ConsoleHistory prev
d356 3
a358 2
    bind Console <<Console_Next>> {
	tk::ConsoleHistory next
d360 8
a367 2
    bind Console <Insert> {
	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
d369 5
a373 2
    bind Console <KeyPress> {
	tk::ConsoleInsert %W %A
d375 1
a375 1
    bind Console <F9> {
d378 1
a378 1
	    if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}
d383 1
a383 1
    bind Console <<Cut>> {
d389 1
d391 1
a391 1
    bind Console <<Copy>> {
d396 1
d398 1
a398 1
    bind Console <<Paste>> {
d400 1
a400 1
	    set clip [::tk::GetSelection %W CLIPBOARD]
d402 1
a402 1
	    tk::ConsoleInsert %W [lindex $list 0]
d405 3
a407 3
		tk::ConsoleInsert %W "\n"
		tk::ConsoleInvoke
		tk::ConsoleInsert %W $x
a409 30
    }

    ##
    ## Bindings for doing special things based on certain keys
    ##
    bind PostConsole <Key-parenright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \( \) promptEnd
	}
    }
    bind PostConsole <Key-bracketright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \[ \] promptEnd
	}
    }
    bind PostConsole <Key-braceright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \{ \} promptEnd
	}
    }
    bind PostConsole <Key-quotedbl> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchQuote %W promptEnd
	}
    }

    bind PostConsole <KeyPress> {
	if {"%A" != ""} {
	    ::tk::console::TagProc %W
	}
d414 1
a414 1
# ::tk::ConsoleInsert --
d424 1
a424 1
proc ::tk::ConsoleInsert {w s} {
d436 1
a436 1
	$w mark set insert end
d442 1
a442 1
# ::tk::ConsoleOutput --
d451 3
a453 5
proc ::tk::ConsoleOutput {dest string} {
    set w .console
    $w insert output $string $dest
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
    $w see insert
d456 1
a456 1
# ::tk::ConsoleExit --
d465 1
a465 1
proc ::tk::ConsoleExit {} {
d469 1
a469 1
# ::tk::ConsoleAbout --
d476 2
a477 1
proc ::tk::ConsoleAbout {} {
d479 1
d481 2
a482 2
Tcl $::tcl_patchLevel
Tk $::tk_patchLevel"
d485 1
a485 317
# ::tk::console::TagProc --
#
# Tags a procedure in the console if it's recognized
# This procedure is not perfect.  However, making it perfect wastes
# too much CPU time...
#
# Arguments:
#	w	- console text widget

proc ::tk::console::TagProc w {
    if {!$::tk::console::magicKeys} { return }
    set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
    set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$i == ""} {set i promptEnd} else {append i +2c}
    regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
    if {[llength [EvalAttached [list info commands $c]]]} {
	$w tag add proc $i "insert-1c wordend"
    } else {
	$w tag remove proc $i "insert-1c wordend"
    }
    if {[llength [EvalAttached [list info vars $c]]]} {
	$w tag add var $i "insert-1c wordend"
    } else {
	$w tag remove var $i "insert-1c wordend"
    }
}

# ::tk::console::MatchPair --
#
# Blinks a matching pair of characters
# c2 is assumed to be at the text index 'insert'.
# This proc is really loopy and took me an hour to figure out given
# all possible combinations with escaping except for escaped \'s.
# It doesn't take into account possible commenting... Oh well.  If
# anyone has something better, I'd like to see/use it.  This is really
# only efficient for small contexts.
#
# Arguments:
#	w	- console text widget
# 	c1	- first char of pair
# 	c2	- second char of pair
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
    if {!$::tk::console::magicKeys} { return }
    if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
	while {
	    [string match {\\} [$w get $ix-1c]] &&
	    [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
	} {}
	set i1 insert-1c
	while {[string compare {} $ix]} {
	    set i0 $ix
	    set j 0
	    while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
		append i0 +1c
		if {[string match {\\} [$w get $i0-2c]]} continue
		incr j
	    }
	    if {!$j} break
	    set i1 $ix
	    while {$j && [string compare {} \
		    [set ix [$w search -back $c1 $ix $lim]]]} {
		if {[string match {\\} [$w get $ix-1c]]} continue
		incr j -1
	    }
	}
	if {[string match {} $ix]} { set ix [$w index $lim] }
    } else { set ix [$w index $lim] }
    if {$::tk::console::blinkRange} {
	Blink $w $ix [$w index insert]
    } else {
	Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::MatchQuote --
#
# Blinks between matching quotes.
# Blinks just the quote if it's unmatched, otherwise blinks quoted string
# The quote to match is assumed to be at the text index 'insert'.
#
# Arguments:
#	w	- console text widget
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchQuote {w {lim 1.0}} {
    if {!$::tk::console::magicKeys} { return }
    set i insert-1c
    set j 0
    while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
	if {[string match {\\} [$w get $i-1c]]} continue
	if {!$j} {set i0 $i}
	incr j
    }
    if {$j&1} {
	if {$::tk::console::blinkRange} {
	    Blink $w $i0 [$w index insert]
	} else {
	    Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
	}
    } else {
	Blink $w [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::Blink --
#
# Blinks between n index pairs for a specified duration.
#
# Arguments:
#	w	- console text widget
# 	i1	- start index to blink region
# 	i2	- end index of blink region
# 	dur	- duration in usecs to blink for
#
# Outputs:
#	blinks selected characters in $w

proc ::tk::console::Blink {w args} {
    eval [list $w tag add blink] $args
    after $::tk::console::blinkTime [list $w] tag remove blink $args
}

# ::tk::console::ConstrainBuffer --
#
# This limits the amount of data in the text widget
# Called by Prompt and ConsoleOutput
#
# Arguments:
#	w	- console text widget
#	size	- # of lines to constrain to
#
# Outputs:
#	may delete data in console widget

proc ::tk::console::ConstrainBuffer {w size} {
    if {[$w index end] > $size} {
	$w delete 1.0 [expr {int([$w index end])-$size}].0
    }
}

# ::tk::console::Expand --
#
# Arguments:
# ARGS:	w	- text widget in which to expand str
# 	type	- type of expansion (path / proc / variable)
#
# Calls:	::tk::console::Expand(Pathname|Procname|Variable)
#
# Outputs:	The string to match is expanded to the longest possible match.
#		If ::tk::console::showMatches is non-zero and the longest match
#		equaled the string to expand, then all possible matches are
#		output to stdout.  Triggers bell if no matches are found.
#
# Returns:	number of matches found

proc ::tk::console::Expand {w {type ""}} {
    set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
    set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
    if {[$w compare $tmp >= insert]} { return }
    set str [$w get $tmp insert]
    switch -glob $type {
	path* { set res [ExpandPathname $str] }
	proc* { set res [ExpandProcname $str] }
	var*  { set res [ExpandVariable $str] }
	default {
	    set res {}
	    foreach t {Pathname Procname Variable} {
		if {![catch {Expand$t $str} res] && ($res != "")} { break }
	    }
	}
    }
    set len [llength $res]
    if {$len} {
	set repl [lindex $res 0]
	$w delete $tmp insert
	$w insert $tmp $repl {input stdin}
	if {($len > 1) && $::tk::console::showMatches \
		&& [string equal $repl $str]} {
	    puts stdout [lsort [lreplace $res 0 0]]
	}
    } else { bell }
    return [incr len -1]
}

# ::tk::console::ExpandPathname --
#
# Expand a file pathname based on $str
# This is based on UNIX file name conventions
#
# Arguments:
#	str	- partial file pathname to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches
 
proc ::tk::console::ExpandPathname str {
    set pwd [EvalAttached pwd]
    if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
	return -code error $err
    }
    set dir [file tail $str]
    ## Check to see if it was known to be a directory and keep the trailing
    ## slash if so (file tail cuts it off)
    if {[string match */ $str]} { append dir / }
    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
	set match {}
    } else {
	if {[llength $m] > 1} {
	    global tcl_platform
	    if {[string match windows $tcl_platform(platform)]} {
		## Windows is screwy because it's case insensitive
		set tmp [ExpandBestMatch [string tolower $m] \
			[string tolower $dir]]
		## Don't change case if we haven't changed the word
		if {[string length $dir]==[string length $tmp]} {
		    set tmp $dir
		}
	    } else {
		set tmp [ExpandBestMatch $m $dir]
	    }
	    if {[string match ?*/* $str]} {
		set tmp [file dirname $str]/$tmp
	    } elseif {[string match /* $str]} {
		set tmp /$tmp
	    }
	    regsub -all { } $tmp {\\ } tmp
	    set match [linsert $m 0 $tmp]
	} else {
	    ## This may look goofy, but it handles spaces in path names
	    eval append match $m
	    if {[file isdir $match]} {append match /}
	    if {[string match ?*/* $str]} {
		set match [file dirname $str]/$match
	    } elseif {[string match /* $str]} {
		set match /$match
	    }
	    regsub -all { } $match {\\ } match
	    ## Why is this one needed and the ones below aren't!!
	    set match [list $match]
	}
    }
    EvalAttached [list cd $pwd]
    return $match
}

# ::tk::console::ExpandProcname --
#
# Expand a tcl proc name based on $str
#
# Arguments:
#	str	- partial proc name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandProcname str {
    set match [EvalAttached [list info commands $str*]]
    if {[llength $match] == 0} {
	set ns [EvalAttached \
		"namespace children \[namespace current\] [list $str*]"]
	if {[llength $ns]==1} {
	    set match [EvalAttached [list info commands ${ns}::*]]
	} else {
	    set match $ns
	}
    }
    if {[llength $match] > 1} {
	regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	set match [linsert $match 0 $str]
    } else {
	regsub -all { } $match {\\ } match
    }
    return $match
}

# ::tk::console::ExpandVariable --
#
# Expand a tcl variable name based on $str
#
# Arguments:
#	str	- partial tcl var name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandVariable str {
    if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
	## Looks like they're trying to expand an array.
	set match [EvalAttached [list array names $ary $str*]]
	if {[llength $match] > 1} {
	    set vars $ary\([ExpandBestMatch $match $str]
	    foreach var $match {lappend vars $ary\($var\)}
	    return $vars
	} else {set match $ary\($match\)}
	## Space transformation avoided for array names.
    } else {
	set match [EvalAttached [list info vars $str*]]
	if {[llength $match] > 1} {
	    regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	    set match [linsert $match 0 $str]
	} else {
	    regsub -all { } $match {\\ } match
	}
    }
    return $match
}
d487 1
a487 28
# ::tk::console::ExpandBestMatch --
#
# Finds the best unique match in a list of names.
# The extra $e in this argument allows us to limit the innermost loop a little
# further.  This improves speed as $l becomes large or $e becomes long.
#
# Arguments:
#	l	- list to find best unique match in
# 	e	- currently best known unique match
#
# Returns:	longest unique match in the list

proc ::tk::console::ExpandBestMatch {l {e {}}} {
    set ec [lindex $l 0]
    if {[llength $l]>1} {
	set e  [string length $e]; incr e -1
	set ei [string length $ec]; incr ei -1
	foreach l $l {
	    while {$ei>=$e && [string first $ec $l]} {
		set ec [string range $ec 0 [incr ei -1]]
	    }
	}
    }
    return $ec
}

# now initialize the console
::tk::ConsoleInit
@


1.10.4.1
log
@2001-02-28  Don Porter  <dgp@@users.sourceforge.net>

        BRANCH dgp-privates-into-namespace:  Feature branch to move all
        of Tk's private commands and variable into the ::tk namespace
        and its children.

        * doc/tkvars.n:  Documented private variable tkPriv renamed tk::Priv.

        * generic/tkBind.c:
        * generic/tkMenu.c:
        * generic/tkTextDisp.c:
        * library/bgerror.tcl:
        * library/button.tcl:
        * library/choosedir.tcl:
        * library/clrpick.tcl:
        * library/comdlg.tcl:
        * library/console.tcl:
        * library/dialog.tcl:
        * library/entry.tcl:
        * library/focus.tcl:
        * library/listbox.tcl:
        * library/menu.tcl:
        * library/msgbox.tcl:
        * library/optMenu.tcl:
        * library/palette.tcl:
        * library/scale.tcl:
        * library/scrlbar.tcl:
        * library/spinbox.tcl:
        * library/tclIndex:
        * library/tearoff.tcl:
        * library/text.tcl:
        * library/tk.tcl:
        * library/tkfbox.tcl:
        * library/xmfbox.tcl:
        * mac/tkMacMenu.c:
        * tests/clrpick.test:
        * tests/filebox.test:
        * tests/macMenu.test:
        * tests/menu.test:
        * tests/menuDraw.test:
        * tests/msgbox.test:
        * tests/text.test:
        * tests/textDisp.test:
        * tests/unixMenu.test:
        * tests/winMenu.test:
        * tests/xmfbox.test:
        * unix/tkUnixDialog.c:  All Tk commands matching ::tk[A-Z]* and
        all Tk private variables in the global namespace were renamed to
        live in the namespace ::tk or one of its children.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.10 2000/11/02 22:55:16 hobbs Exp $
d18 1
a18 1
# ::tk::ConsoleInit --
d24 1
a24 1
proc ::tk::ConsoleInit {} {
d43 1
a43 1
	    -underline 0 -command tk::ConsoleSource
d72 1
a72 1
		-underline 0 -command tk::ConsoleAbout
d90 1
a90 1
    ConsoleBind .console
d101 1
a101 1
    tk::TextSetCursor .console end
d106 1
a106 1
# ::tk::ConsoleSource --
d113 1
a113 1
proc ::tk::ConsoleSource {} {
d122 1
a122 1
	    ConsoleOutput stderr "$result\n"
d127 1
a127 1
# ::tk::ConsoleInvoke --
d135 1
a135 1
proc ::tk::ConsoleInvoke {args} {
d148 1
a148 1
	ConsolePrompt
d156 2
a157 2
	ConsoleHistory reset
	ConsolePrompt
d159 1
a159 1
	ConsolePrompt partial
d164 1
a164 1
# ::tk::ConsoleHistory --
d167 2
a168 2
# main interpreter to obtain the history.  The variable
# ::tk::histNum is used to store the current location in the history.
d173 3
a175 3
set ::tk::histNum 1
proc ::tk::ConsoleHistory {cmd} {
    variable histNum
d214 1
a214 1
# ::tk::ConsolePrompt --
d222 1
a222 1
proc ::tk::ConsolePrompt {{partial normal}} {
d242 1
a242 1
    ::tk::TextSetCursor .console end
d247 1
a247 1
# ::tk::ConsoleBind --
d255 1
a255 1
proc ::tk::ConsoleBind {win} {
d270 1
a270 1
	tk::ConsoleInsert %W \t
d276 2
a277 2
	tk::ConsoleInsert %W "\n"
	tk::ConsoleInvoke
d297 1
a297 1
		tk::TextSetCursor %W {insert linestart}
d299 1
a299 1
		tk::TextSetCursor %W promptEnd
d306 1
a306 1
	    tk::TextSetCursor %W {insert lineend}
d342 1
a342 1
	    tk::ConsoleHistory prev
d348 1
a348 1
	    tk::ConsoleHistory next
d353 1
a353 1
	catch {tk::ConsoleInsert %W [selection get -displayof %W]}
d357 1
a357 1
	tk::ConsoleInsert %W %A
d365 1
a365 1
	    tk::TextSetCursor %W insert-1c
d371 1
a371 1
	    tk::TextSetCursor %W insert+1c
d402 1
a402 1
	    tk::ConsoleInsert %W [lindex $list 0]
d405 3
a407 3
		tk::ConsoleInsert %W "\n"
		tk::ConsoleInvoke
		tk::ConsoleInsert %W $x
d414 1
a414 1
# ::tk::ConsoleInsert --
d424 1
a424 1
proc ::tk::ConsoleInsert {w s} {
d442 1
a442 1
# ::tk::ConsoleOutput --
d451 1
a451 1
proc ::tk::ConsoleOutput {dest string} {
d456 1
a456 1
# ::tk::ConsoleExit --
d465 1
a465 1
proc ::tk::ConsoleExit {} {
d469 1
a469 1
# ::tk::ConsoleAbout --
d476 1
a476 1
proc ::tk::ConsoleAbout {} {
d487 1
a487 1
::tk::ConsoleInit
@


1.10.4.2
log
@        * Merged in updates from HEAD branch.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.10.4.1 2001/02/28 23:29:56 dgp Exp $
d353 1
a353 1
	catch {tk::ConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
d400 1
a400 1
	    set clip [::tk::GetSelection %W CLIPBOARD]
@


1.10.4.3
log
@	* Renamed tk::histNum to tk::HistNum
	as directed by the Tcl Style Guide.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.10.4.2 2001/07/03 20:01:09 dgp Exp $
d168 1
a168 1
# ::tk::HistNum is used to store the current location in the history.
d173 1
a173 1
set ::tk::HistNum 1
d175 1
a175 1
    variable HistNum
d179 2
a180 2
	    incr HistNum -1
	    if {$HistNum == 0} {
d183 1
a183 1
		set cmd "history event $HistNum"
d186 1
a186 1
    	    	incr HistNum
d193 2
a194 2
	    incr HistNum
	    if {$HistNum == 0} {
d196 1
a196 1
	    } elseif {$HistNum > 0} {
d198 1
a198 1
		set HistNum 1
d200 1
a200 1
		set cmd "history event $HistNum"
d209 1
a209 1
    	    set HistNum 1
@


1.9
log
@* library/msgs/de.msg: German message catalog.

* library/msgs/en.msg: English message catalog.

* library/msgs/es.msg: Spanish message catalog.

* library/msgs/fr.msg: French message catalog.

* unix/Makefile.in:
* unix/configure.in:
* library/tk.tcl:
* library/clrpick.tcl:
* library/choosedir.tcl:
* library/console.tcl:
* library/msgbox.tcl:
* library/tkfbox.tcl:
* library/xmfbox.tcl:
* library/bgerror.tcl: Applied patches from Laurent Duperval to
provide localization of Tk dialogs. [RFE: 2671].
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8 2000/04/21 04:06:37 hobbs Exp $
a8 1
# Copyright (c) 1998-1999 Scriptics Corp.
d10 1
d479 1
a479 1
Copyright \251 2000 Scriptics Corporation
@


1.8
log
@	* library/console.tcl: made console use systemfixed font on Win
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.7 1999/09/02 17:02:52 hobbs Exp $
d42 4
a45 4
    .menubar.file add command -label "Source..." -underline 0 \
	    -command tkConsoleSource
    .menubar.file add command -label "Hide Console" -underline 0 \
	    -command {wm withdraw .}
d47 2
a48 1
	.menubar.file add command -label "Exit" -underline 1 -command exit
d50 2
a51 1
	.menubar.file add command -label "Quit" -command exit -accel Cmd-Q
d55 1
a55 1
    .menubar.edit add command -label "Cut" -underline 2 \
d57 1
a57 1
    .menubar.edit add command -label "Copy" -underline 0 \
d59 1
a59 1
    .menubar.edit add command -label "Paste" -underline 1 \
d63 1
a63 1
	.menubar.edit add command -label "Clear" -underline 2 \
d66 1
a66 1
	.menubar.edit add command -label "Delete" -underline 0 \
d68 1
a68 1

d71 2
a72 2
	.menubar.help add command -label "About..." -underline 0 \
		-command tkConsoleAbout
d98 1
a98 1
    wm title . "Console"
d115 4
a118 2
		      -title "Select a file to source" \
		      -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
d478 1
a478 1
    tk_messageBox -type ok -message "Tcl for Windows
@


1.8.2.1
log
@	* library/console.tcl:  added more smarts extracted from tkcon to
	the default console.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8 2000/04/21 04:06:37 hobbs Exp $
a16 21
package require msgcat

namespace eval ::tk::console {
    variable blinkTime   500 ; # msecs to blink braced range for
    variable blinkRange  1   ; # enable blinking of the entire braced range
    variable magicKeys   1   ; # enable brace matching and proc/var recognition
    variable maxLines    600 ; # maximum # of lines buffered in console
    variable showMatches 1   ; # show multiple expand matches

    variable inPlugin [info exists embed_args]
    variable defaultPrompt  ; # default prompt if tcl_prompt1 isn't used

    if {$inPlugin} {
	set defaultPrompt {subst "[history nextid] % "}
    } else {
	set defaultPrompt {subst "([file tail [pwd]]) [history nextid] % "}
    }
}

# simple compat function for tkcon code added for this console
interp alias {} EvalAttached {} consoleinterp eval
a45 2
    .menubar.file add command -label [::msgcat::mc "Clear Console"] \
	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
d75 2
a76 2
    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
    scrollbar .sb -command [list $con yview]
d78 1
a78 1
    pack $con -fill both -expand 1 -side left
d81 1
a81 1
	    $con configure -font {Monaco 9 normal} -highlightthickness 0
d84 1
a84 1
	    $con configure -font systemfixed
d88 1
a88 1
    tkConsoleBind $con
d90 2
a91 8
    $con tag configure stderr	-foreground red
    $con tag configure stdin	-foreground blue
    $con tag configure prompt	-foreground \#8F4433
    $con tag configure proc	-foreground \#008800
    $con tag configure var	-background \#FFC0D0
    $con tag raise sel
    $con tag configure blink	-background \#FFFF00
    $con tag configure find	-background \#FFFF00
d93 1
a93 1
    focus $con
d98 4
a101 4
    $con mark set output [$con index "end - 1 char"]
    tkTextSetCursor $con end
    $con mark set promptEnd insert
    $con mark gravity promptEnd left
d113 2
a114 2
	    -title "Select a file to source" \
	    -filetypes {{"Tcl Scripts" .tcl} {"All Files" *}}]
a218 1
    set w .console
d220 2
a221 2
	set temp [$w index "end - 1 char"]
	$w mark set output end
d225 1
a225 1
    	    puts -nonewline [EvalAttached $::tk::console::defaultPrompt]
d228 2
a229 2
	set temp [$w index output]
	$w mark set output end
d237 4
a240 6
    $w mark set output $temp
    tkTextSetCursor $w end
    $w mark set promptEnd insert
    $w mark gravity promptEnd left
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
    $w see end
d251 2
a252 7
proc tkConsoleBind {w} {
    bindtags $w [list $w Console PostConsole [winfo toplevel $w] all]

    ## Get all Text bindings into Console
    foreach ev [bind Text] { bind Console $ev [bind Text $ev] }	
    ## We really didn't want the newline insertion
    bind Console <Control-Key-o> {}
d256 2
d259 5
a263 30
    bind Console <Alt-KeyPress> {# nothing }
    bind Console <Meta-KeyPress> {# nothing}
    bind Console <Control-KeyPress> {# nothing}

    foreach {ev key} {
	<<Console_Prev>>		<Key-Up>
	<<Console_Next>>		<Key-Down>
	<<Console_NextImmediate>>	<Control-Key-n>
	<<Console_PrevImmediate>>	<Control-Key-p>
	<<Console_PrevSearch>>		<Control-Key-r>
	<<Console_NextSearch>>		<Control-Key-s>

	<<Console_Expand>>		<Key-Escape>
	<<Console_ExpandFile>>		<Control-Shift-Key-F>
	<<Console_ExpandProc>>		<Control-Shift-Key-P>
	<<Console_ExpandVar>>		<Control-Shift-Key-V>
	<<Console_Tab>>			<Control-Key-i>
	<<Console_Tab>>			<Meta-Key-i>
	<<Console_Eval>>		<Key-Return>
	<<Console_Eval>>		<Key-KP_Enter>

	<<Console_Clear>>		<Control-Key-l>
	<<Console_KillLine>>		<Control-Key-k>
	<<Console_Transpose>>		<Control-Key-t>
	<<Console_ClearLine>>		<Control-Key-u>
	<<Console_SaveCommand>>		<Control-Key-z>
    } {
	event add $ev $key
	bind Console $key {}
    }
d265 1
a265 1
    bind Console <Tab> {
d270 1
a270 13
    bind Console <<Console_Expand>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W}
    }
    bind Console <<Console_ExpandFile>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W path}
    }
    bind Console <<Console_ExpandProc>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W proc}
    }
    bind Console <<Console_ExpandVar>> {
	if {[%W compare insert > promptEnd]} {::tk::console::Expand %W var}
    }
    bind Console <<Console_Eval>> {
d276 28
a303 17
    bind Console <Delete> {
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert >= promptEnd]} {
	    %W delete insert
	    %W see insert
	}
    }
    bind Console <BackSpace> {
	if {[string compare {} [%W tag nextrange sel 1.0 end]] \
		&& [%W compare sel.first >= promptEnd]} {
	    %W delete sel.first sel.last
	} elseif {[%W compare insert != 1.0] && \
		[%W compare insert > promptEnd]} {
	    %W delete insert-1c
	    %W see insert
d306 1
a306 3
    bind Console <Control-h> [bind Console <BackSpace>]

    bind Console <Home> {
d308 1
a308 3
	    tk::TextSetCursor %W {insert linestart}
	} else {
	    tk::TextSetCursor %W promptEnd
d311 3
a313 15
    bind Console <Control-a> [bind Console <Home>]
    bind Console <End> {
	tk::TextSetCursor %W {insert lineend}
    }
    bind Console <Control-e> [bind Console <End>]
    bind Console <Control-d> {
	if {[%W compare insert < promptEnd]} break
	%W delete insert
    }
    bind Console <<Console_KillLine>> {
	if {[%W compare insert < promptEnd]} break
	if {[%W compare insert == {insert lineend}]} {
	    %W delete insert
	} else {
	    %W delete insert {insert lineend}
d316 4
a319 3
    bind Console <<Console_Transpose>> {
	## Transpose current and previous chars
	if {[%W compare insert > promptEnd]} { ::tk::TextTranspose %W }
d321 3
a323 11
    bind Console <<Console_Clear>> {
	## Clear console display
	%W delete 1.0 "promptEnd linestart"
    }
    bind Console <<Console_ClearLine>> {
	## Clear command line (Unix shell staple)
	%W delete promptEnd end
    }
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d326 3
a328 3
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
d331 3
a333 3
    bind Console <Meta-d> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d336 4
a339 3
    bind Console <Meta-BackSpace> {
	if {[%W compare {insert -1c wordstart} >= promptEnd]} {
	    %W delete {insert -1c wordstart} insert
d342 4
a345 3
    bind Console <Meta-Delete> {
	if {[%W compare insert >= promptEnd]} {
	    %W delete insert {insert wordend}
d348 3
a350 2
    bind Console <<Console_Prev>> {
	tkConsoleHistory prev
d352 3
a354 2
    bind Console <<Console_Next>> {
	tkConsoleHistory next
d356 8
a363 2
    bind Console <Insert> {
	catch {tkConsoleInsert %W [::tk::GetSelection %W PRIMARY]}
d365 5
a369 2
    bind Console <KeyPress> {
	tkConsoleInsert %W %A
d371 1
a371 1
    bind Console <F9> {
d379 1
a379 1
    bind Console <<Cut>> {
d385 1
d387 1
a387 1
    bind Console <<Copy>> {
d392 1
d394 1
a394 1
    bind Console <<Paste>> {
d396 1
a396 1
	    set clip [::tk::GetSelection %W CLIPBOARD]
a405 30
    }

    ##
    ## Bindings for doing special things based on certain keys
    ##
    bind PostConsole <Key-parenright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \( \) promptEnd
	}
    }
    bind PostConsole <Key-bracketright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \[ \] promptEnd
	}
    }
    bind PostConsole <Key-braceright> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchPair %W \{ \} promptEnd
	}
    }
    bind PostConsole <Key-quotedbl> {
	if {[string compare \\ [%W get insert-2c]]} {
	    ::tk::console::MatchQuote %W promptEnd
	}
    }

    bind PostConsole <KeyPress> {
	if {"%A" != ""} {
	    ::tk::console::TagProc %W
	}
a448 1
    ::tk::console::ConstrainBuffer $w $::tk::console::maxLines
d475 1
a478 344
}

# ::tk::console::TagProc --
#
# Tags a procedure in the console if it's recognized
# This procedure is not perfect.  However, making it perfect wastes
# too much CPU time...
#
# Arguments:
#	w	- console text widget

proc ::tk::console::TagProc w {
    if {!$::tk::console::magicKeys} { return }
    set exp "\[^\\\\\]\[\[ \t\n\r\;{}\"\$\]"
    set i [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$i == ""} {set i promptEnd} else {append i +2c}
    regsub -all "\[\[\\\\\\?\\*\]" [$w get $i "insert-1c wordend"] {\\\0} c
    if {[llength [EvalAttached [list info commands $c]]]} {
	$w tag add proc $i "insert-1c wordend"
    } else {
	$w tag remove proc $i "insert-1c wordend"
    }
    if {[llength [EvalAttached [list info vars $c]]]} {
	$w tag add var $i "insert-1c wordend"
    } else {
	$w tag remove var $i "insert-1c wordend"
    }
}

# ::tk::console::MatchPair --
#
# Blinks a matching pair of characters
# c2 is assumed to be at the text index 'insert'.
# This proc is really loopy and took me an hour to figure out given
# all possible combinations with escaping except for escaped \'s.
# It doesn't take into account possible commenting... Oh well.  If
# anyone has something better, I'd like to see/use it.  This is really
# only efficient for small contexts.
#
# Arguments:
#	w	- console text widget
# 	c1	- first char of pair
# 	c2	- second char of pair
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
    if {!$::tk::console::magicKeys} { return }
    if {[string compare {} [set ix [$w search -back $c1 insert $lim]]]} {
	while {
	    [string match {\\} [$w get $ix-1c]] &&
	    [string compare {} [set ix [$w search -back $c1 $ix-1c $lim]]]
	} {}
	set i1 insert-1c
	while {[string compare {} $ix]} {
	    set i0 $ix
	    set j 0
	    while {[string compare {} [set i0 [$w search $c2 $i0 $i1]]]} {
		append i0 +1c
		if {[string match {\\} [$w get $i0-2c]]} continue
		incr j
	    }
	    if {!$j} break
	    set i1 $ix
	    while {$j && [string compare {} \
		    [set ix [$w search -back $c1 $ix $lim]]]} {
		if {[string match {\\} [$w get $ix-1c]]} continue
		incr j -1
	    }
	}
	if {[string match {} $ix]} { set ix [$w index $lim] }
    } else { set ix [$w index $lim] }
    if {$::tk::console::blinkRange} {
	Blink $w $ix [$w index insert]
    } else {
	Blink $w $ix $ix+1c [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::MatchQuote --
#
# Blinks between matching quotes.
# Blinks just the quote if it's unmatched, otherwise blinks quoted string
# The quote to match is assumed to be at the text index 'insert'.
#
# Arguments:
#	w	- console text widget
#
# Calls:	::tk::console::Blink
 
proc ::tk::console::MatchQuote {w {lim 1.0}} {
    if {!$::tk::console::magicKeys} { return }
    set i insert-1c
    set j 0
    while {[string compare [set i [$w search -back \" $i $lim]] {}]} {
	if {[string match {\\} [$w get $i-1c]]} continue
	if {!$j} {set i0 $i}
	incr j
    }
    if {$j&1} {
	if {$::tk::console::blinkRange} {
	    Blink $w $i0 [$w index insert]
	} else {
	    Blink $w $i0 $i0+1c [$w index insert-1c] [$w index insert]
	}
    } else {
	Blink $w [$w index insert-1c] [$w index insert]
    }
}

# ::tk::console::Blink --
#
# Blinks between n index pairs for a specified duration.
#
# Arguments:
#	w	- console text widget
# 	i1	- start index to blink region
# 	i2	- end index of blink region
# 	dur	- duration in usecs to blink for
#
# Outputs:
#	blinks selected characters in $w

proc ::tk::console::Blink {w args} {
    eval [list $w tag add blink] $args
    after $::tk::console::blinkTime [list $w] tag remove blink $args
}

# ::tk::console::ConstrainBuffer --
#
# This limits the amount of data in the text widget
# Called by Prompt and ConsoleOutput
#
# Arguments:
#	w	- console text widget
#	size	- # of lines to constrain to
#
# Outputs:
#	may delete data in console widget

proc ::tk::console::ConstrainBuffer {w size} {
    if {[$w index end] > $size} {
	$w delete 1.0 [expr {int([$w index end])-$size}].0
    }
}

# ::tk::console::Expand --
#
# Arguments:
# ARGS:	w	- text widget in which to expand str
# 	type	- type of expansion (path / proc / variable)
#
# Calls:	::tk::console::Expand(Pathname|Procname|Variable)
#
# Outputs:	The string to match is expanded to the longest possible match.
#		If ::tk::console::showMatches is non-zero and the longest match
#		equaled the string to expand, then all possible matches are
#		output to stdout.  Triggers bell if no matches are found.
#
# Returns:	number of matches found

proc ::tk::console::Expand {w {type ""}} {
    set exp "\[^\\\\\]\[\[ \t\n\r\\\{\"\\\\\$\]"
    set tmp [$w search -backwards -regexp $exp insert-1c promptEnd-1c]
    if {$tmp == ""} {set tmp promptEnd} else {append tmp +2c}
    if {[$w compare $tmp >= insert]} { return }
    set str [$w get $tmp insert]
    switch -glob $type {
	path* { set res [ExpandPathname $str] }
	proc* { set res [ExpandProcname $str] }
	var*  { set res [ExpandVariable $str] }
	default {
	    set res {}
	    foreach t {Pathname Procname Variable} {
		if {![catch {Expand$t $str} res] && ($res != "")} { break }
	    }
	}
    }
    set len [llength $res]
    if {$len} {
	set repl [lindex $res 0]
	$w delete $tmp insert
	$w insert $tmp $repl {input stdin}
	if {($len > 1) && $::tk::console::showMatches \
		&& [string equal $repl $str]} {
	    puts stdout [lsort [lreplace $res 0 0]]
	}
    } else { bell }
    return [incr len -1]
}

## ::tk::console::ExpandPathname --
#
# Expand a file pathname based on $str
# This is based on UNIX file name conventions
#
# Arguments:
#	str	- partial file pathname to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches
 
proc ::tk::console::ExpandPathname str {
    set pwd [EvalAttached pwd]
    if {[catch {EvalAttached [list cd [file dirname $str]]} err]} {
	return -code error $err
    }
    set dir [file tail $str]
    ## Check to see if it was known to be a directory and keep the trailing
    ## slash if so (file tail cuts it off)
    if {[string match */ $str]} { append dir / }
    if {[catch {lsort [EvalAttached [list glob $dir*]]} m]} {
	set match {}
    } else {
	if {[llength $m] > 1} {
	    global tcl_platform
	    if {[string match windows $tcl_platform(platform)]} {
		## Windows is screwy because it's case insensitive
		set tmp [ExpandBestMatch [string tolower $m] \
			[string tolower $dir]]
		## Don't change case if we haven't changed the word
		if {[string length $dir]==[string length $tmp]} {
		    set tmp $dir
		}
	    } else {
		set tmp [ExpandBestMatch $m $dir]
	    }
	    if {[string match ?*/* $str]} {
		set tmp [file dirname $str]/$tmp
	    } elseif {[string match /* $str]} {
		set tmp /$tmp
	    }
	    regsub -all { } $tmp {\\ } tmp
	    set match [linsert $m 0 $tmp]
	} else {
	    ## This may look goofy, but it handles spaces in path names
	    eval append match $m
	    if {[file isdir $match]} {append match /}
	    if {[string match ?*/* $str]} {
		set match [file dirname $str]/$match
	    } elseif {[string match /* $str]} {
		set match /$match
	    }
	    regsub -all { } $match {\\ } match
	    ## Why is this one needed and the ones below aren't!!
	    set match [list $match]
	}
    }
    EvalAttached [list cd $pwd]
    return $match
}

# ::tk::console::ExpandProcname --
#
# Expand a tcl proc name based on $str
#
# Arguments:
#	str	- partial proc name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandProcname str {
    set match [EvalAttached [list info commands $str*]]
    if {[llength $match] == 0} {
	set ns [EvalAttached \
		"namespace children \[namespace current\] [list $str*]"]
	if {[llength $ns]==1} {
	    set match [EvalAttached [list info commands ${ns}::*]]
	} else {
	    set match $ns
	}
    }
    if {[llength $match] > 1} {
	regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	set match [linsert $match 0 $str]
    } else {
	regsub -all { } $match {\\ } match
    }
    return $match
}

# ::tk::console::ExpandVariable --
#
# Expand a tcl variable name based on $str
#
# Arguments:
#	str	- partial tcl var name to expand
#
# Calls:	::tk::console::ExpandBestMatch
#
# Returns:	list containing longest unique match followed by all the
#		possible further matches

proc ::tk::console::ExpandVariable str {
    if {[regexp {([^\(]*)\((.*)} $str junk ary str]} {
	## Looks like they're trying to expand an array.
	set match [EvalAttached [list array names $ary $str*]]
	if {[llength $match] > 1} {
	    set vars $ary\([ExpandBestMatch $match $str]
	    foreach var $match {lappend vars $ary\($var\)}
	    return $vars
	} else {set match $ary\($match\)}
	## Space transformation avoided for array names.
    } else {
	set match [EvalAttached [list info vars $str*]]
	if {[llength $match] > 1} {
	    regsub -all { } [ExpandBestMatch $match $str] {\\ } str
	    set match [linsert $match 0 $str]
	} else {
	    regsub -all { } $match {\\ } match
	}
    }
    return $match
}

# ::tk::console::ExpandBestMatch --
#
# Finds the best unique match in a list of names.
# The extra $e in this argument allows us to limit the innermost loop a little
# further.  This improves speed as $l becomes large or $e becomes long.
#
# Arguments:
#	l	- list to find best unique match in
# 	e	- currently best known unique match
#
# Returns:	longest unique match in the list

proc ::tk::console::ExpandBestMatch {l {e {}}} {
    set ec [lindex $l 0]
    if {[llength $l]>1} {
	set e  [string length $e]; incr e -1
	set ei [string length $ec]; incr ei -1
	foreach l $l {
	    while {$ei>=$e && [string first $ec $l]} {
		set ec [string range $ec 0 [incr ei -1]]
	    }
	}
    }
    return $ec
@


1.8.2.2
log
@	* library/console.tcl (tkConsoleOutput): fixed undefined widget
	argument.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8.2.1 2001/10/09 23:10:31 hobbs Exp $
d547 1
a547 2
    set w .console
    $w insert output $string $dest
d549 1
a549 1
    $w see insert
@


1.8.2.3
log
@	* library/console.tcl: fixed a few errors where namespace command
	names were used that were not back-ported from 8.4.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8.2.2 2001/10/18 20:26:24 hobbs Exp $
a290 4
    # For the moment, transpose isn't enabled until the console
    # gets and overhaul of how it handles input -- hobbs
    bind Console <Control-Key-t> {}

d371 1
a371 1
	    tkTextSetCursor %W {insert linestart}
d373 1
a373 1
	    tkTextSetCursor %W promptEnd
d378 1
a378 1
	tkTextSetCursor %W {insert lineend}
d392 4
@


1.8.2.4
log
@        * generic/tkConsole.c:
        * library/console.tcl:
        * mac/tkMacInit.c:
        * mac/tkMacResource.r: corrected how mac deals with tcl library
        files present both in resources and in $tk_library directory.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8.2.3 2001/10/19 17:33:27 hobbs Exp $
d445 1
a445 1
	    if {[catch {source $tk_library:console.tcl}]} {source -rsrc console}
@


1.8.2.5
log
@        * library/console.tcl (tkConsoleBind): Corrected console <<Paste>>
        binding on Unix platforms.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8.2.4 2001/10/19 19:40:17 das Exp $
d288 1
a288 1
    ## We really didn't want the newline insertion...
a289 2
    ## ...or any Control-v binding (would block <<Paste>>)
    bind Console <Control-Key-v> {}
@


1.8.2.6
log
@	* library/console.tcl: corrected the defaultPrompt substitution
	[Bug #553207] and made Tab a default expansion key (like Escape).
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.8.2.5 2002/03/01 00:03:57 dgp Exp $
d30 1
a30 1
	set defaultPrompt {subst {[history nextid] % }}
d32 1
a32 1
	set defaultPrompt {subst {([file tail [pwd]]) [history nextid] % }}
a311 1
	<<Console_Expand>>		<Key-Tab>
d331 5
@


1.7
log
@1999-09-01  Jeff Hobbs  <hobbs@@scriptics.com>

	* library/msgbox.tcl: changed the behavior of tk_messageBox on
	Unix to be more Windows like in handling of <Return> and the
	default button
	* library/button.tcl:
	* library/clrpick.tcl:
	* library/comdlg.tcl:
	* library/console.tcl:
	* library/dialog.tcl:
	* library/entry.tcl:
	* library/focus.tcl:
	* library/listbox.tcl:
	* library/menu.tcl:
	* library/msgbox.tcl:
	* library/palette.tcl:
	* library/safetk.tcl:
	* library/scale.tcl:
	* library/scrlbar.tcl:
	* library/tearoff.tcl:
	* library/text.tcl:
	* library/tk.tcl:
	* library/tkfbox.tcl:
	* library/xmfbox.tcl: updated commands to use [string] ops
	instead of expr equality operators
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.6 1999/08/10 15:27:49 hobbs Exp $
d79 7
a85 2
    if {[string equal $tcl_platform(platform) "macintosh"]} {
        .console configure -font {Monaco 9 normal} -highlightthickness 0
d475 1
a475 1
Copyright \251 1999 Scriptics Corporation
@


1.6
log
@1999-08-10  Jeff Hobbs  <hobbs@@scriptics.com>

	* library/clrpick.tcl:
	* library/console.tcl:
	* library/tk.tcl: fixed code where abbreviations where used
	in calling widget methods (confuses iWidgets) [Bug: 2422]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.5 1999/05/22 01:59:21 stanton Exp $
d34 1
a34 1
      set mod "Cmd"
d43 1
a43 1
	-command tkConsoleSource
d45 1
a45 1
	-command {wm withdraw .}
d49 1
a49 1
      .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
d54 1
a54 1
	-command { event generate .console <<Cut>> } -accel "$mod+X"
d56 1
a56 1
	-command { event generate .console <<Copy>> } -accel "$mod+C"
d58 1
a58 1
	-command { event generate .console <<Paste>> } -accel "$mod+V"
d61 2
a62 2
      .menubar.edit add command -label "Clear" -underline 2 \
          -command { event generate .console <<Clear>> }
d65 1
a65 1
	    -command { event generate .console <<Clear>> } -accel "Del"
d70 1
a70 1
	    -command tkConsoleAbout
d79 1
a79 1
    if {![string compare $tcl_platform(platform) "macintosh"]} {
d131 1
a131 1
      while {[string compare [lindex $ranges $pos] ""]} {
d138 1
a138 1
    if {![string compare $cmd ""]} {
d144 1
a144 1
      if {[string compare $result ""]} {
d193 1
a193 1
          if {[string compare $cmd ""]} {
d214 1
a214 1
    if {![string compare $partial "normal"]} {
d272 1
a272 1
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
d274 2
a275 4
	} else {
	    if {[%W compare insert < promptEnd]} {
		break
	    }
d279 1
a279 1
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
d281 2
a282 4
	} else {
	    if {[%W compare insert <= promptEnd]} {
		break
	    }
d368 1
a368 1
      if {![string compare $tcl_platform(platform) "macintosh"]} {
d416 1
a416 1
    if {![string compare $s ""]} {
@


1.5
log
@Merged changes from scriptics-tclpro-1-3-b2 branch
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
d73 1
a73 1
    . conf -menu .menubar
@


1.4
log
@* Merged 8.1 branch into the main trunk
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d9 1
d474 1
a474 1
Copyright \251 1996 Sun Microsystems, Inc.
@


1.4.2.1
log
@Fix copyright string in console about box.
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.4 1999/04/16 01:51:26 stanton Exp $
a8 1
# Copyright (c) 1998-1999 Scriptics Corp.
d473 1
a473 1
Copyright \251 1999 Scriptics Corporation
@


1.3
log
@Replaced SCCS strings, fixed binary files
@
text
@d26 1
a26 1
    if {! [consoleinterp eval {set tcl_interactive}]} {
d30 2
a31 2
    if {"$tcl_platform(platform)" == "macintosh"} {
	set mod "Cmd"
d33 1
a33 1
	set mod "Ctrl"
d45 2
a46 2
    if {"$tcl_platform(platform)" == "macintosh"} {
	.menubar.file add command -label "Quit" -command exit -accel Cmd-Q
d48 1
a48 1
	.menubar.file add command -label "Exit" -underline 1 -command exit
d59 4
a62 1
    if {"$tcl_platform(platform)" == "windows"} {
a69 3
    } else {
	.menubar.edit add command -label "Clear" -underline 2 \
	    -command { event generate .console <<Clear>> }
d78 1
a78 1
    if {$tcl_platform(platform) == "macintosh"} {
d109 1
a109 1
    if {"$filename" != ""} {
d128 1
a128 1
    if {$ranges != ""} {
d130 1
a130 1
	while {[lindex $ranges $pos] != ""} {
d137 1
a137 1
    if {$cmd == ""} {
d143 2
a144 2
	if {$result != ""} {
	    .console insert insert "$result\n"
d192 1
a192 1
	    if {$cmd != ""} {
d213 1
a213 1
    if {$partial == "normal"} {
d271 1
a271 1
	if {[%W tag nextrange sel 1.0 end] != ""} {
d280 1
a280 1
	if {[%W tag nextrange sel 1.0 end] != ""} {
d371 1
a371 1
	if {$tcl_platform(platform) == "macintosh"} {
d419 1
a419 1
    if {$s == ""} {
@


1.2
log
@plugin updates
@
text
@d7 1
a7 1
# SCCS: @@(#) console.tcl 1.45 97/09/17 16:52:40
@


1.1
log
@Initial revision
@
text
@d111 1
a111 1
	if [catch {consoleinterp eval $cmd} result] {
d139 1
a139 1
    } elseif [info complete $cmd] {
d171 1
a171 1
		set cmd {history event [expr [history nextid] -1]}
d185 1
a185 1
		set cmd {history event [expr [history nextid] -1]}
d216 1
a216 1
    	if [consoleinterp eval "info exists tcl_prompt1"] {
d224 1
a224 1
    	if [consoleinterp eval "info exists tcl_prompt2"] {
d274 1
a274 1
	    if [%W compare insert < promptEnd] {
d283 1
a283 1
	    if [%W compare insert <= promptEnd] {
d290 1
a290 1
	    if [%W compare insert < promptEnd] {
d305 1
a305 1
	if [%W compare insert < promptEnd] {
d310 1
a310 1
	if [%W compare insert < promptEnd] {
d315 1
a315 1
	if [%W compare insert < promptEnd] {
d320 1
a320 1
	if [%W compare insert < promptEnd] {
d325 1
a325 1
	if [%W compare insert <= promptEnd] {
d330 1
a330 1
	if [%W compare insert <= promptEnd] {
d356 1
a356 1
	    if [%W compare insert == promptEnd] {
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d7 1
a7 1
# SCCS: @@(#) console.tcl 1.47 98/01/02 17:42:06
d111 1
a111 1
	if {[catch {consoleinterp eval $cmd} result]} {
d139 1
a139 1
    } elseif {[info complete $cmd]} {
d144 1
a144 1
	    puts $result
d171 1
a171 1
		set cmd {history event [expr {[history nextid] -1}]}
d185 1
a185 1
		set cmd {history event [expr {[history nextid] -1}]}
d216 1
a216 1
    	if {[consoleinterp eval "info exists tcl_prompt1"]} {
d224 1
a224 1
    	if {[consoleinterp eval "info exists tcl_prompt2"]} {
d274 1
a274 1
	    if {[%W compare insert < promptEnd]} {
d283 1
a283 1
	    if {[%W compare insert <= promptEnd]} {
d290 1
a290 1
	    if {[%W compare insert < promptEnd]} {
d305 1
a305 1
	if {[%W compare insert < promptEnd]} {
d310 1
a310 1
	if {[%W compare insert < promptEnd]} {
d315 1
a315 1
	if {[%W compare insert < promptEnd]} {
d320 1
a320 1
	if {[%W compare insert < promptEnd]} {
d325 1
a325 1
	if {[%W compare insert <= promptEnd]} {
d330 1
a330 1
	if {[%W compare insert <= promptEnd]} {
d356 1
a356 1
	    if {[%W compare insert == promptEnd]} {
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d7 1
a7 1
# RCS: @@(#) $Id: console.tcl,v 1.3 1998/09/14 18:23:22 stanton Exp $
@


1.1.4.3
log
@* library/bgerror.tcl:
* library/button.tcl:
* library/clrpick.tcl:
* library/console.tcl:
* library/dialog.tcl:
* library/entry.tcl:
* library/focus.tcl:
* library/listbox.tcl:
* library/menu.tcl:
* library/msgbox.tcl:
* library/palette.tcl:
* library/scale.tcl:
* library/scrlbar.tcl:
* library/tearoff.tcl:
* library/text.tcl:
* library/tk.tcl: Lots of minor performance improvements
contributed by Jeffrey Hobbs. [Bug: 1118]
@
text
@d7 1
a7 1
# RCS: @@(#) $Id$
d26 1
a26 1
    if {![consoleinterp eval {set tcl_interactive}]} {
d30 3
a32 1
    if {[string compare $tcl_platform(platform) "macintosh"]} {
a33 2
    } else {
      set mod "Cmd"
d45 3
a47 1
    if {[string compare $tcl_platform(platform) "macintosh"]} {
a48 2
    } else {
      .menubar.file add command -label "Quit" -command exit -accel Cmd-Q
d59 1
a59 4
    if {[string compare $tcl_platform(platform) "windows"]} {
      .menubar.edit add command -label "Clear" -underline 2 \
          -command { event generate .console <<Clear>> }
    } else {
d67 3
d78 1
a78 1
    if {![string compare $tcl_platform(platform) "macintosh"]} {
d109 1
a109 1
    if {[string compare $filename ""]} {
d128 1
a128 1
    if {[llength $ranges]} {
d130 1
a130 1
      while {[string compare [lindex $ranges $pos] ""]} {
d137 1
a137 1
    if {![string compare $cmd ""]} {
d143 1
a143 1
      if {[string compare $result ""]} {
d192 1
a192 1
          if {[string compare $cmd ""]} {
d213 1
a213 1
    if {![string compare $partial "normal"]} {
d271 1
a271 1
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
d280 1
a280 1
      if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
d371 1
a371 1
      if {![string compare $tcl_platform(platform) "macintosh"]} {
d419 1
a419 1
    if {![string compare $s ""]} {
@


