Tk Source Code

# 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.17 2002/03/01 00:04:27 dgp Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
#
# 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
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

    }

    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

    menu .menubar.file -tearoff 0
    .menubar.file add command -label [::msgcat::mc "Source..."] \
	    -underline 0 -command tk::ConsoleSource
    .menubar.file add command -label [::msgcat::mc "Hide Console"] \
	    -underline 0 -command {wm withdraw .}
    .menubar.file add command -label [::msgcat::mc "Clear Console"] \
	    -underline 0 -command {.console delete 1.0 "promptEnd linestart"}
    if {[string compare $tcl_platform(platform) "macintosh"]} {
	.menubar.file add command -label [::msgcat::mc "Exit"] \
		-underline 1 -command exit
    } else {
	.menubar.file add command -label [::msgcat::mc "Quit"] \
		-command exit -accel Cmd-Q
    }

    menu .menubar.edit -tearoff 0
    .menubar.edit add command -label [::msgcat::mc "Cut"] -underline 2 \
	    -command { event generate .console <<Cut>> } -accel "$mod+X"
    .menubar.edit add command -label [::msgcat::mc "Copy"] -underline 0 \
	    -command { event generate .console <<Copy>> } -accel "$mod+C"
    .menubar.edit add command -label [::msgcat::mc "Paste"] -underline 1 \
	    -command { event generate .console <<Paste>> } -accel "$mod+V"

    if {[string compare $tcl_platform(platform) "windows"]} {
	.menubar.edit add command -label [::msgcat::mc "Clear"] -underline 2 \
		-command { event generate .console <<Clear>> }
    } else {
	.menubar.edit add command -label [::msgcat::mc "Delete"] -underline 0 \
		-command { event generate .console <<Clear>> } -accel "Del"
	
	.menubar add cascade -label Help -menu .menubar.help -underline 0
	menu .menubar.help -tearoff 0
	.menubar.help add command -label [::msgcat::mc "About..."] \
		-underline 0 -command tk::ConsoleAbout
    }

    . configure -menu .menubar

    set con [text .console  -yscrollcommand [list .sb set] -setgrid true]
    scrollbar .sb -command [list $con yview]

    $con tag raise sel
    $con tag configure blink	-background \#FFFF00
    $con tag configure find	-background \#FFFF00

    focus $con

    wm protocol . WM_DELETE_WINDOW { wm withdraw . }
    wm title . [::msgcat::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
}

# ::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 [::msgcat::mc "Select a file to source"] \
	    -filetypes [list \
	    [list [::msgcat::mc "Tcl Scripts"] .tcl] \
	    [list [::msgcat::mc "All Files"] *]]]
    if {[string compare $filename ""]} {
    	set cmd [list source $filename]
	if {[catch {consoleinterp eval $cmd} result]} {
	    ConsoleOutput stderr "$result\n"
	}
    }
}

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

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

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

# ::tk::console::TagProc --
#