summaryrefslogtreecommitdiffstats
path: root/library/console.tcl
diff options
context:
space:
mode:
authorfvogel <fvogelnew1@free.fr>2016-01-11 13:23:20 (GMT)
committerfvogel <fvogelnew1@free.fr>2016-01-11 13:23:20 (GMT)
commitddae56bbd0023f29a24d0529ed4fa0e3820ce7f2 (patch)
tree87dfd77a94fb45488edde792e3b0735459a1fea7 /library/console.tcl
parent5c01788dc22a4a2f8e6d9e943dc61a5b73b28291 (diff)
parent4a2efd946fe6674e460172920d097f7329d8e5d9 (diff)
downloadtk-ddae56bbd0023f29a24d0529ed4fa0e3820ce7f2.zip
tk-ddae56bbd0023f29a24d0529ed4fa0e3820ce7f2.tar.gz
tk-ddae56bbd0023f29a24d0529ed4fa0e3820ce7f2.tar.bz2
merged trunk
Diffstat (limited to 'library/console.tcl')
-rw-r--r--library/console.tcl42
1 files changed, 32 insertions, 10 deletions
diff --git a/library/console.tcl b/library/console.tcl
index e93a39d..ba68ccc 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -41,8 +41,6 @@ interp alias {} EvalAttached {} consoleinterp eval
# None.
proc ::tk::ConsoleInit {} {
- global tcl_platform
-
if {![consoleinterp eval {set tcl_interactive}]} {
wm withdraw .
}
@@ -78,7 +76,7 @@ proc ::tk::ConsoleInit {} {
AmpMenuArgs .menubar.edit add command -label [mc P&aste] -accel "$mod+V"\
-command {event generate .console <<Paste>>}
- if {$tcl_platform(platform) ne "windows"} {
+ if {[tk windowingsystem] ne "win32"} {
AmpMenuArgs .menubar.edit add command -label [mc Cl&ear] \
-command {event generate .console <<Clear>>}
} else {
@@ -114,6 +112,8 @@ proc ::tk::ConsoleInit {} {
-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>>}
+ AmpMenuArgs .menubar.edit add command -label [mc "Fit To Screen Width"] \
+ -command {event generate .console <<Console_FitScreenWidth>>}
if {[tk windowingsystem] eq "aqua"} {
.menubar add cascade -label [mc Window] -menu [menu .menubar.window]
@@ -193,7 +193,7 @@ proc ::tk::ConsoleInit {} {
$w mark set promptEnd insert
$w mark gravity promptEnd left
- if {$tcl_platform(platform) eq "windows"} {
+ if {[tk windowingsystem] ne "aqua"} {
# 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 }
@@ -311,7 +311,7 @@ proc ::tk::ConsoleHistory {cmd} {
# ::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
+# exists in the main interpreter it will be called to generate the
# prompt. Otherwise, a hard coded default prompt is printed.
#
# Arguments:
@@ -378,6 +378,26 @@ proc ::tk::console::Paste {w} {
}
}
+# Fit TkConsoleFont to window width
+proc ::tk::console::FitScreenWidth {w} {
+ set width [winfo screenwidth $w]
+ set cwidth [$w cget -width]
+ set s -50
+ set fit 0
+ array set fi [font configure TkConsoleFont]
+ while {$s < 0} {
+ set fi(-size) $s
+ set f [font create {*}[array get fi]]
+ set c [font measure $f "eM"]
+ font delete $f
+ if {$c * $cwidth < 1.667 * $width} {
+ font configure TkConsoleFont -size $s
+ break
+ }
+ incr s 2
+ }
+}
+
# ::tk::ConsoleBind --
# This procedure first ensures that the default bindings for the Text
# class have been defined. Then certain bindings are overridden for
@@ -600,6 +620,9 @@ proc ::tk::ConsoleBind {w} {
tk fontchooser configure -font TkConsoleFont
}
}
+ bind Console <<Console_FitScreenWidth>> {
+ ::tk::console::FitScreenWidth %W
+ }
##
## Bindings for doing special things based on certain keys
@@ -781,7 +804,7 @@ proc ::tk::console::TagProc w {
# c2 - second char of pair
#
# Calls: ::tk::console::Blink
-
+
proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
if {!$::tk::console::magicKeys} {
return
@@ -836,7 +859,7 @@ proc ::tk::console::MatchPair {w c1 c2 {lim 1.0}} {
# w - console text widget
#
# Calls: ::tk::console::Blink
-
+
proc ::tk::console::MatchQuote {w {lim 1.0}} {
if {!$::tk::console::magicKeys} {
return
@@ -971,7 +994,7 @@ proc ::tk::console::Expand {w {type ""}} {
#
# 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 opt]} {
@@ -987,8 +1010,7 @@ proc ::tk::console::ExpandPathname str {
set match {}
} else {
if {[llength $m] > 1} {
- global tcl_platform
- if {[string match windows $tcl_platform(platform)]} {
+ if { $::tcl_platform(platform) eq "windows" } {
## Windows is screwy because it's case insensitive
set tmp [ExpandBestMatch [string tolower $m] \
[string tolower $dir]]