1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
-
+
-
|
# 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 $
# RCS: @(#) $Id: console.tcl,v 1.18 2002/04/29 13:17:44 bagnonm 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
|
| ︙ | | |
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
-
+
|
}
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..."] \
.menubar.file add command -label [mc "Source..."] \
-underline 0 -command tk::ConsoleSource
.menubar.file add command -label [::msgcat::mc "Hide Console"] \
.menubar.file add command -label [mc "Hide Console"] \
-underline 0 -command {wm withdraw .}
.menubar.file add command -label [::msgcat::mc "Clear Console"] \
.menubar.file add command -label [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"] \
.menubar.file add command -label [mc "Exit"] \
-underline 1 -command exit
} else {
.menubar.file add command -label [::msgcat::mc "Quit"] \
.menubar.file add command -label [mc "Quit"] \
-command exit -accel Cmd-Q
}
menu .menubar.edit -tearoff 0
.menubar.edit add command -label [::msgcat::mc "Cut"] -underline 2 \
.menubar.edit add command -label [mc "Cut"] -underline 2 \
-command { event generate .console <<Cut>> } -accel "$mod+X"
.menubar.edit add command -label [::msgcat::mc "Copy"] -underline 0 \
.menubar.edit add command -label [mc "Copy"] -underline 0 \
-command { event generate .console <<Copy>> } -accel "$mod+C"
.menubar.edit add command -label [::msgcat::mc "Paste"] -underline 1 \
.menubar.edit add command -label [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 \
.menubar.edit add command -label [mc "Clear"] -underline 2 \
-command { event generate .console <<Clear>> }
} else {
.menubar.edit add command -label [::msgcat::mc "Delete"] -underline 0 \
.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
menu .menubar.help -tearoff 0
.menubar.help add command -label [::msgcat::mc "About..."] \
.menubar.help add command -label [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]
|
| ︙ | | |
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
-
+
-
+
-
-
+
+
|
$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"]
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
}
# ::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"] \
-title [mc "Select a file to source"] \
-filetypes [list \
[list [::msgcat::mc "Tcl Scripts"] .tcl] \
[list [::msgcat::mc "All Files"] *]]]
[list [mc "Tcl Scripts"] .tcl] \
[list [mc "All Files"] *]]]
if {[string compare $filename ""]} {
set cmd [list source $filename]
if {[catch {consoleinterp eval $cmd} result]} {
ConsoleOutput stderr "$result\n"
}
}
}
|
| ︙ | | |
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
|
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
|
-
+
|
#
# 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}]
tk_messageBox -type ok -message "[mc {Tcl for Windows}]
Tcl $::tcl_patchLevel
Tk $::tk_patchLevel"
}
# ::tk::console::TagProc --
#
|
| ︙ | | |
