Check-in [8f1663c8a7]
Not logged in
Overview
Comment: .vimrc vimrc Modified Files: c_ft.vim config_ft.vim cpp_ft.vim fortran_ft.vim html_ft.vim tcl_ft.vim vim_ft.vim Modified Files: CmdlineCompl.vim tab.vim Added Files: FileTypeChanged.vim tclreadlineCompleter.tcl tclreadlineInit.tcl.in tclreadlineSetup.tcl.in
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:8f1663c8a77a6ddffc709bfaf38a51c585bd6fb3
User & Date: johannes@zellner.org on 1999-09-15 16:20:56
Other Links: manifest | tags
Context
1999-09-16
00:48
Modified Files: .vimrc share/vim/ft/tcl_ft.vim share/vim/functions/tab.vim src/tclreadline/tclreadlineCompleter.tcl Added Files: share/vim/functions/CruiseTags.vim src/csym/version check-in: 307416781d user: johannes@zellner.org tags: trunk
1999-09-15
16:20
.vimrc vimrc Modified Files: c_ft.vim config_ft.vim cpp_ft.vim fortran_ft.vim html_ft.vim tcl_ft.vim vim_ft.vim Modified Files: CmdlineCompl.vim tab.vim Added Files: FileTypeChanged.vim tclreadlineCompleter.tcl tclreadlineInit.tcl.in tclreadlineSetup.tcl.in check-in: 8f1663c8a7 user: johannes@zellner.org tags: trunk
01:08
Modified Files: .vimrc share/vim/VIM/vimrc share/vim/ft/tcl_ft.vim src/tclreadline/tclreadline.c src/tclreadline/tclreadlineCompleter.tcl Added Files: src/csym/version check-in: 3e20727e08 user: johannes@zellner.org tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified tclreadlineCompleter.tcl from [17e4a4595b] to [d3c3f77ed1].

1
2
3
4
5
6
7
8
9
10
..
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
...
229
230
231
232
233
234
235
236

237
238
239
240
241
242
243
244
245
246
247




248
249
250
251
252
253
254

255
256
257
258
259
260
261
...
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
...
786
787
788
789
790
791
792
793

794
795
796
797
798
799
800
...
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
....
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
....
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
....
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
....
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
....
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
....
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171












3172
3173

3174
3175
3176
3177
3178
3179
3180
....
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190

3191
3192
3193
3194
3195
3196
3197

3198

3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209


3210
3211



3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225





































































3226
3227
3228
3229
3230
3231
3232
....
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
....
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
# -*- tclsh -*-
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 02:59:18 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
# ================================================================== 


# TODO:
#
#     - tcltest is missing
#
#     - last try: as for widgets
#



namespace eval tclreadline {

namespace export \
................................................................................
# @param cmd
# @return list of options for cmd
# @date Sep-14-1999
#
proc TrySubCmds {cmd} {
	set trystring ____
	set result ""
	if [catch {set result [${cmd} ${trystring}]} msg] {

		if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
			regsub -all -- , ${raw} { } raw
			set len [llength ${raw}]
			set len_2 [expr ${len} - 2]
			for {set i 0} {${i} < ${len}} {incr i} {
				set word [lindex ${raw} ${i}]
				if {"or" != ${word} && ${i} != ${len_2}} {
					lappend result ${word}
				}

			}




		} else {
			# check, if it's a blt error msg ...
			#
			set msglst [split ${msg} \n]
			foreach line ${msglst} {
				if {[regexp "${cmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]} {

					lappend result [list ${sub}]
				}
			}
		}
	}
	return ${result}
}
................................................................................
		return ${pre}${res}
	} else {
		return ${res}
	}
	return ""
}

proc BraceOrControlStatement {text start end line pos mod} {
	if {![string length [Lindex $line $pos]]} {
		return [list \{ {}]; # \}
	} else {
		set new_line [string trim [IncompleteListRemainder $line]]
		if {![regexp {^([\{\"])(.*)$} $new_line all pre new_line]} {
			set pre ""
		}
................................................................................
# DATE: Sep-06-1999
#
proc EventuallyEvaluateFirst {partT startT endT lineT} {
	# return; # disabled
	upvar $partT part $startT start $endT end $lineT line

	set oldlen [string length ${line}]
	set line [string trim ${line}]

	set diff [expr [string length $line] - $oldlen]
	incr start $diff
	incr end $diff

	set char [string index ${line} 0]
	if {{[} != ${char} && {$} != ${char}} {return}

................................................................................
					return [DisplayHints <$arg>]
				}
			}
		}


		# Ok, also no proc. Try to do the same as for widgets now:
		# try to get at least the first option from an error output.
		# if the subcommand is configure or cget, try to get the
		# option table.
		#
		switch -- $pos {
			1 {
				set cmds [TrySubCmds ${alias}]
				if {[llength ${cmds}]} {
					return [TryFromList ${part} ${cmds}]
				}
			}
			default {
				set sub [Lindex $line 1]
				switch -- $sub {
					configure -
					cget {
						return [CompleteFromOptions \
						${part} ${start} ${line} ${alias}]
					}
				}
			}
		}


		# no specific command completer found.
		return ""
	}
	error "{NOTREACHED (this is probably an error)}"
}


# explicit command completers
#
................................................................................

proc complete(for) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 -
		3 -
		4 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
		}
	}
	return ""
}

proc complete(foreach) {text start end line pos mod} {
	switch -- $pos {
................................................................................
	# we don't offer the completion `then':
	# it's optional, more difficult to parse
	# and who uses it anyway?
	#
	switch -- $pos {
		1 -
		2 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
		}
		default {
			set prev [PreviousWord ${start} ${line}]
			switch -- $prev {
				then -
				else -
				elseif {
					return [BraceOrControlStatement \
					$text $start $end $line $pos $mod]
				}
				default {
					if {-1 == [lsearch [ProperList $line] else]} {
						return [CompleteFromList $text {else elseif}]
					}
				}
................................................................................
				children -
				export -
				forget -
				import { return [DisplayHints ?pattern?] }
				delete { return [TryFromList ${mod} $space_matches] }
				eval -
				inscope {
					return [BraceOrControlStatement \
					$text $start $end $line $pos $mod]
				}
				which { return [CompleteFromList ${mod} {-variable <name>}] }
			}
		}
		4 {
			switch -- $cmd {
................................................................................
	return ""
}

proc complete(while) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 {
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
		}
	}
	return ""
}

# -------------------------------------
#                  TK
................................................................................
# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
	upvar $optionsT options
	# first we build an option table
	#
	if {[catch [list set option_table [${cmd} configure]] msg]} {
		return 0
	}
	foreach optline ${option_table} {
		if {5 != [llength ${optline}]} continue else {
			lappend options(switches) [lindex ${optline} 0]
			lappend options(value)    [lindex ${optline} 4]
		}
................................................................................

#**
# try to complete a `cmd configure|cget ..' from the command's options.
# @param text start line cmd, standard tclreadlineCompleter arguments.
# @return a tclreadline completer formatted string.
# @date Sep-14-1999
#
proc CompleteFromOptions {text start line cmd} {

	set prev [PreviousWord ${start} ${line}]













	if {0 < [OptionTable ${cmd} options]} {


		if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {

			# complete only if the user has not
			# already entered something here.
			#
			if {![llength ${text}]} {
				# use this double list to quote option
................................................................................
				# values which have to be quoted.
				#
				return [list [list [lindex $options(value) ${found}]]]
			}

		} else {
			return [CompleteFromList ${text} \
			[RemoveUsedOptions $line $options(switches)]]
		}
	}

}

proc complete(WIDGET) {text start end line pos mod} {
	set widget [Lindex ${line} 0]
	set cmd [Lindex ${line} 1]
	switch -- $pos {
		1 {

			set cmds [TrySubCmds ${widget}]

			if {[llength ${cmds}]} {
				return [TryFromList ${mod} ${cmds}]
			}
		}
		default {
			if {([string match ${cmd}* cget] || \
				[string match ${cmd}* configure])
			} {
				return [CompleteFromOptions ${text} ${start} ${line} ${widget}]
			}
		}


	}
	return ""



}

# SPECIFIC TK COMMAND COMPLETERS

proc complete(bell) {text start end line pos mod} {
	switch -- $pos {
		1 { return [CompleteFromList ${text} -displayof] }
		2 {
			if {"-displayof" == [PreviousWord ${start} ${line}]} {
				return [CompleteFromList ${text} [ToplevelWindows]]
			}
		}
	}
}






































































proc complete(bind) {text start end line pos mod} {
	switch -- $pos {
		1 {
			set widgets [WidgetChildren ${text}]
			set toplevels [ToplevelWindows]
			if {[catch {set toplevelClass [winfo class .]}]} {
................................................................................
				Scale Scrollbar Text
				all
			}
			return [CompleteFromList ${text} \
			[concat $toplevels $widgets $toplevelClass $rest]]
		}
		2 {
			if {![string length ${text}]} {
				# insert a < and inhibit further completion
				return [list < {}]
			} elseif {[regexp > ${text}]} {
				set diff [expr [CountChar ${text} <] - [CountChar ${text} >]]
				for {set i 0} {$i < $diff} {incr i} {
					append text >
				}
				append text " "
				return ${text}
			} else {
				regexp -- {^(.*[<-])([^<-]*)} ${text} all left right
			}
			set modifiers {
				Alt Control Shift Lock Double Triple
				B1 B2 B3 B4 B5 Button1 Button2 Button3 Button4 Button5
				M M1 M2 M3 M4 M5        
				Meta Mod1 Mod2 Mod3 Mod4 Mod5
			}
			set events {
................................................................................
				Activate Button ButtonPress ButtonRelease
				Circulate Colormap Configure Deactivate Destroy
				Enter Expose FocusIn FocusOut Gravity
				Key KeyPress KeyRelease Leave Map Motion
				MouseWheel Property Reparent Unmap Visibility
			}
			set sequence [concat $modifiers $events]
			set exact_matches [MatchesFromList ${right} ${sequence}]
			# TODO this is awkward. Think of making it better!
			#
			if {1 == [llength ${exact_matches}] && \
				-1 != [lsearch ${sequence} ${right}]
			} {
				set completion [CompleteFromList ${right} {> -} 1]
			} else {
				set completion [CompleteFromList ${right} $sequence 1]
			}
			if {![string length [lindex $completion 0]]} {
				return [concat ${left} [lrange $completion 1 end]]
			} else {
				return ${left}${completion}
			}
		}
		3 {
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrControlStatement $text $start $end $line $pos $mod]
		}
	}
	return ""
}

proc complete(image) {text start end line pos mod} {
	set sub [Lindex $line 1]

|
|







 







<







 







|
>











>
>
>
>





|
|
>







 







|







 







|
>







 







|
|
|

<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<







 







|







 







|







|







 







|







 







|







 







|







 







|

|
|
>
>
>
>
>
>
>
>
>
>
>
>


>







 







|


>


|
<
|
|
|
>
|
>
|
|
|
|
<
<
|
<
<
|
|
>
>
|
|
>
>
>





|








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<
<
<
<
<
<
<
<
<
<
<
<







 







|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<







1
2
3
4
5
6
7
8
9
10
..
28
29
30
31
32
33
34

35
36
37
38
39
40
41
...
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
...
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
...
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
...
987
988
989
990
991
992
993
994
995
996
997












998









999
1000
1001
1002
1003
1004
1005
....
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
....
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
....
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
....
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
....
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
....
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
....
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192

3193
3194
3195
3196
3197
3198
3199
3200
3201
3202


3203


3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
....
3308
3309
3310
3311
3312
3313
3314













3315
3316
3317
3318
3319
3320
3321
....
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345


3346
3347
3348
3349
3350
3351
3352
# -*- tclsh -*-
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 18:18:13 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
# ================================================================== 


# TODO:
#
#     - tcltest is missing
#

#



namespace eval tclreadline {

namespace export \
................................................................................
# @param cmd
# @return list of options for cmd
# @date Sep-14-1999
#
proc TrySubCmds {cmd} {
	set trystring ____
	set result ""
	if [catch {set result [eval ${cmd} ${trystring}]} msg] {
		set tcmd [string trim ${cmd}]
		if {[regexp {bad *option.*____.*: *must *be( .*$)} ${msg} all raw]} {
			regsub -all -- , ${raw} { } raw
			set len [llength ${raw}]
			set len_2 [expr ${len} - 2]
			for {set i 0} {${i} < ${len}} {incr i} {
				set word [lindex ${raw} ${i}]
				if {"or" != ${word} && ${i} != ${len_2}} {
					lappend result ${word}
				}

			}
		} elseif {[regexp "wrong # args: should be \"${tcmd}\(.*\)\"" \
			${msg} all hint]
		} {
			set result [string trim $hint]
		} else {
			# check, if it's a blt error msg ...
			#
			set msglst [split ${msg} \n]
			foreach line ${msglst} {
				if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]
				} {
					lappend result [list ${sub}]
				}
			}
		}
	}
	return ${result}
}
................................................................................
		return ${pre}${res}
	} else {
		return ${res}
	}
	return ""
}

proc BraceOrCommand {text start end line pos mod} {
	if {![string length [Lindex $line $pos]]} {
		return [list \{ {}]; # \}
	} else {
		set new_line [string trim [IncompleteListRemainder $line]]
		if {![regexp {^([\{\"])(.*)$} $new_line all pre new_line]} {
			set pre ""
		}
................................................................................
# DATE: Sep-06-1999
#
proc EventuallyEvaluateFirst {partT startT endT lineT} {
	# return; # disabled
	upvar $partT part $startT start $endT end $lineT line

	set oldlen [string length ${line}]
	# set line [string trim ${line}]
	set line [string trimleft ${line}]
	set diff [expr [string length $line] - $oldlen]
	incr start $diff
	incr end $diff

	set char [string index ${line} 0]
	if {{[} != ${char} && {$} != ${char}} {return}

................................................................................
					return [DisplayHints <$arg>]
				}
			}
		}


		# Ok, also no proc. Try to do the same as for widgets now:
		# try to complete from the option table if the subcommand
		# is `configure' or `cget' otherwise try to get further
		# subcommands.
		#












		return [CompleteFromOptionsOrSubCmds $part $start $end $line $pos]









	}
	error "{NOTREACHED (this is probably an error)}"
}


# explicit command completers
#
................................................................................

proc complete(for) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 -
		3 -
		4 {
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
	}
	return ""
}

proc complete(foreach) {text start end line pos mod} {
	switch -- $pos {
................................................................................
	# we don't offer the completion `then':
	# it's optional, more difficult to parse
	# and who uses it anyway?
	#
	switch -- $pos {
		1 -
		2 {
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
		default {
			set prev [PreviousWord ${start} ${line}]
			switch -- $prev {
				then -
				else -
				elseif {
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				default {
					if {-1 == [lsearch [ProperList $line] else]} {
						return [CompleteFromList $text {else elseif}]
					}
				}
................................................................................
				children -
				export -
				forget -
				import { return [DisplayHints ?pattern?] }
				delete { return [TryFromList ${mod} $space_matches] }
				eval -
				inscope {
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				which { return [CompleteFromList ${mod} {-variable <name>}] }
			}
		}
		4 {
			switch -- $cmd {
................................................................................
	return ""
}

proc complete(while) {text start end line pos mod} {
	switch -- $pos {
		1 -
		2 {
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
	}
	return ""
}

# -------------------------------------
#                  TK
................................................................................
# @return number of options
# @date Sep-14-1999
#
proc OptionTable {cmd optionsT} {
	upvar $optionsT options
	# first we build an option table
	#
	if {[catch [list set option_table [eval ${cmd}]] msg]} {
		return 0
	}
	foreach optline ${option_table} {
		if {5 != [llength ${optline}]} continue else {
			lappend options(switches) [lindex ${optline} 0]
			lappend options(value)    [lindex ${optline} 4]
		}
................................................................................

#**
# try to complete a `cmd configure|cget ..' from the command's options.
# @param text start line cmd, standard tclreadlineCompleter arguments.
# @return a tclreadline completer formatted string.
# @date Sep-14-1999
#
proc CompleteFromOptions {text start line} {

	# check if either `configure' or `cget' is present.
	#
	set lst [ProperList ${line}]
	foreach keyword {configure cget} {
		set idx [lsearch ${lst} ${keyword}]
		if {-1 != ${idx}} {
			break
		}
	}
	if {-1 == ${idx}} {
		return
	}
	set cmd [lrange ${lst} 0 ${idx}]
	# puts stderr cmd=|$cmd|
	if {0 < [OptionTable ${cmd} options]} {

		set prev [PreviousWord ${start} ${line}]
		if {-1 != [set found [lsearch -exact $options(switches) ${prev}]]} {

			# complete only if the user has not
			# already entered something here.
			#
			if {![llength ${text}]} {
				# use this double list to quote option
................................................................................
				# values which have to be quoted.
				#
				return [list [list [lindex $options(value) ${found}]]]
			}

		} else {
			return [CompleteFromList ${text} \
			[RemoveUsedOptions ${line} $options(switches)]]
		}
	}
	return ""
}

proc CompleteFromOptionsOrSubCmds {text start end line pos} {

	set from_opts [CompleteFromOptions ${text} ${start} ${line}]
	if {[string length ${from_opts}]} {
		return ${from_opts}
	} else {
		set cmds [TrySubCmds [lrange [ProperList ${line}] 0 [expr $pos - 1]]]
		# puts stderr cmds=|$cmds|
		if {[llength ${cmds}]} {
			return [TryFromList ${text} ${cmds}]
		}
	}


	return ""


}

proc complete(WIDGET) {text start end line pos mod} {
	# set widget [Lindex ${line} 0]
	# set cmds [TrySubCmds ${widget}]
	# if {[llength ${cmds}]} {
	# 	return [TryFromList ${mod} ${cmds}]
	# }
	return [CompleteFromOptionsOrSubCmds ${text} ${start} ${end} ${line} ${pos}]
}

# SPECIFIC TK COMMAND COMPLETERS

proc complete(bell) {text start end line pos mod} {
	switch -- ${pos} {
		1 { return [CompleteFromList ${text} -displayof] }
		2 {
			if {"-displayof" == [PreviousWord ${start} ${line}]} {
				return [CompleteFromList ${text} [ToplevelWindows]]
			}
		}
	}
}

#**
# TODO: shit. make this better!
# @param text, a std completer argument (current word).
# @param fullpart, the full text of the current position.
# @param lst, the list to complete from.
# @param pre, leading `quote'.
# @param sep, word separator.
# @param post, trailing `quote'.
# @return a formatted completer string.
# @date Sep-15-1999
#
proc CompleteListFromList {text fullpart lst pre sep post} {

	# puts stderr ""
	# puts stderr text=|$text|
	# puts stderr lst=|$lst|
	# puts stderr pre=|$pre|
	# puts stderr sep=|$sep|
	# puts stderr post=|$post|

	if {![string length ${fullpart}]} {

		# nothing typed so far. Insert a $pre
		# and inhibit further completion.
		#
		return [list ${pre} {}]

	} elseif {[regexp ${post} ${text}]} {

		# finalize
		#
		set diff \
		[expr [CountChar ${fullpart} ${pre}] - [CountChar ${fullpart} ${post}]]
		for {set i 0} {${i} < ${diff}} {incr i} {
			append text ${post}
		}
		append text " "
		return ${text}

	} elseif {![regexp -- ^\(.*\[${pre}${sep}\]\)\(\[^${pre}${sep}\]*\)$ \
		${text} all left right]
	} {
		set left {}
		set right ${text}
	}

	# puts stderr \nleft=|$left|
	# puts stderr \nright=|$right|
	set exact_matches [MatchesFromList ${right} ${lst}]
	# TODO this is awkward. Think of making it better!
	#
	if {1 == [llength ${exact_matches}] && -1 != [lsearch ${lst} ${right}]
	} {
		#set completion [CompleteFromList ${right} [list ${sep} ${post}] 1]
		return [list ${left}${right}${sep} {}]
	} else {
		set completion [CompleteFromList ${right} ${lst} 1]
	}
	# puts stderr \ncompletion=|$completion|
	if {![string length [lindex $completion 0]]} {
		return [concat [list ${left}] [lrange $completion 1 end]]
	} elseif {[string length ${left}]} {
		return [list ${left}]${completion}
	} else {
		return ${completion}
	}
	return ""
}

proc complete(bind) {text start end line pos mod} {
	switch -- $pos {
		1 {
			set widgets [WidgetChildren ${text}]
			set toplevels [ToplevelWindows]
			if {[catch {set toplevelClass [winfo class .]}]} {
................................................................................
				Scale Scrollbar Text
				all
			}
			return [CompleteFromList ${text} \
			[concat $toplevels $widgets $toplevelClass $rest]]
		}
		2 {













			set modifiers {
				Alt Control Shift Lock Double Triple
				B1 B2 B3 B4 B5 Button1 Button2 Button3 Button4 Button5
				M M1 M2 M3 M4 M5        
				Meta Mod1 Mod2 Mod3 Mod4 Mod5
			}
			set events {
................................................................................
				Activate Button ButtonPress ButtonRelease
				Circulate Colormap Configure Deactivate Destroy
				Enter Expose FocusIn FocusOut Gravity
				Key KeyPress KeyRelease Leave Map Motion
				MouseWheel Property Reparent Unmap Visibility
			}
			set sequence [concat $modifiers $events]
			return [CompleteListFromList ${text} \
			[Lindex $line 2] ${sequence} < - >]
		}
		3 {
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
	}
	return ""
}

proc complete(bindtags) {text start end line pos mod} {
	switch -- $pos {
		1 { return [CompleteFromList ${text} [WidgetChildren ${text}]] }
		2 {
			return [CompleteListFromList ${text} [Lindex $line 2] \
			[bindtags [Lindex $line 1]] \{ { } \}]


		}
	}
	return ""
}

proc complete(image) {text start end line pos mod} {
	set sub [Lindex $line 1]

Modified tclreadlineInit.tcl.in from [3dbe39d793] to [a1f8bae947].

1
2
3
4
5
6
7
8
9
10
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#!/usr/local/bin/tclsh
# FILE: "/diska/home/joze/src/tclreadline/tclreadlineInit.tcl.in"
# LAST MODIFICATION: "Wed Sep  8 18:09:57 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
# http://www.zellner.org/tclreadline/
#
# ================================================================== 

package provide tclreadline @TCLREADLINE_VERSION@

namespace eval tclreadline:: {
    namespace export Init
}

proc ::tclreadline::Init {} {
    
    if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] {
        puts stderr $msg
        exit 2
    }
}

tclreadline::Init
::tclreadline::readline customcompleter ::tclreadline::ScriptCompleter

source [file join [file dirname [info script]] tclreadlineSetup.tcl]

set auto_index(::tclreadline::ScriptCompleter) \
[list source [file join [file dirname [info script]] tclreadlineCompleter.tcl]]

|
|







 







|



|
|
|
|
|









1
2
3
4
5
6
7
8
9
10
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#!/usr/local/bin/tclsh
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineInit.tcl.in"
# LAST MODIFICATION: "Wed Sep 15 15:23:16 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
# http://www.zellner.org/tclreadline/
#
# ================================================================== 

package provide tclreadline @TCLREADLINE_VERSION@

namespace eval tclreadline:: {
	namespace export Init
}

proc ::tclreadline::Init {} {
	
	if [catch {load @TCLREADLINE_LIBRARY@/@TCLREADLINE_LIB_FILE@} msg] {
		puts stderr $msg
		exit 2
	}
}

tclreadline::Init
::tclreadline::readline customcompleter ::tclreadline::ScriptCompleter

source [file join [file dirname [info script]] tclreadlineSetup.tcl]

set auto_index(::tclreadline::ScriptCompleter) \
[list source [file join [file dirname [info script]] tclreadlineCompleter.tcl]]

Modified tclreadlineSetup.tcl.in from [026fd75a9a] to [4dfd34c126].

1
2
3
4
5
6
7
8
9
10
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Mon Sep 13 23:44:55 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................


# package provide tclreadline @TCLREADLINE_VERSION@
package provide tclreadline 0.9

proc unknown args {

    global auto_noexec auto_noload env unknown_pending tcl_interactive
    global errorCode errorInfo

    # Save the values of errorCode and errorInfo variables, since they
    # may get modified if caught errors occur below.  The variables will
    # be restored just before re-executing the missing command.

    set savedErrorCode $errorCode
    set savedErrorInfo $errorInfo
    set name [lindex $args 0]
    if ![info exists auto_noload] {
        #
        # Make sure we're not trying to load the same proc twice.
        #
        if [info exists unknown_pending($name)] {
            return -code error "self-referential recursion in \"unknown\" for command \"$name\""
        }
        set unknown_pending($name) pending
        set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
        unset unknown_pending($name)
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error while autoloading \"$name\": $msg"
        }
        if ![array size unknown_pending] {
            unset unknown_pending
        }
        if $msg {
            set errorCode $savedErrorCode
            set errorInfo $savedErrorInfo
            set code [catch {uplevel 1 $args} msg]
            if {$code ==  1} {
                #
                # Strip the last five lines off the error stack (they're
                # from the "uplevel" command).
                #

                set new [split $errorInfo \n]
                set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
                return -code error -errorcode $errorCode \
                        -errorinfo $new $msg
            } else {
                return -code $code $msg
            }
        }
    }

    # REMOVED THE [info script] TEST (joze, SEP 98)
    if {([info level] == 1) \
            && [info exists tcl_interactive] && $tcl_interactive} {
        if ![info exists auto_noexec] {
            set new [auto_execok $name]
            if {$new != ""} {
                set errorCode $savedErrorCode
                set errorInfo $savedErrorInfo
                set redir ""
                if {[info commands console] == ""} {
                    set redir ">&@stdout <@stdin"
                }
                # LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
                return [uplevel eval exec $redir $new \
                    [::tclreadline::Glob [lrange $args 1 end]]]
            }
        }
        set errorCode $savedErrorCode
        set errorInfo $savedErrorInfo
        if {$name == "!!"} {
            set newcmd [history event]
        } elseif {[regexp {^!(.+)$} $name dummy event]} {
            set newcmd [history event $event]
        } elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
            set newcmd [history event -1]
            catch {regsub -all -- $old $newcmd $new newcmd}
        }
        if [info exists newcmd] {
            tclLog $newcmd
            history change $newcmd 0
            return [uplevel $newcmd]
        }

        set ret [catch {set cmds [info commands $name*]} msg]
        if {[string compare $name "::"] == 0} {
            set name ""
        }
        if {$ret != 0} {
            return -code $ret -errorcode $errorCode \
                "error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
        }
        if {[llength $cmds] == 1} {
            return [uplevel [lreplace $args 0 0 $cmds]]
        }
        if {[llength $cmds] != 0} {
            if {$name == ""} {
                return -code error "empty command name \"\""
            } else {
                return -code error \
                        "ambiguous command name \"$name\": [lsort $cmds]"
            }
        }
    }
    return -code error "invalid command name \"$name\""
}

namespace eval tclreadline {

namespace export Setup Glob Loop InitTclCmds InitTkCmds Print ls

proc ls {args} {
    if {[exec uname -s] == "Linux"} {
        eval exec ls --color -FC [Glob $args]
    } else {
        eval exec ls -FC [Glob $args]
    }
}

proc Setup {args} {

    uplevel #0 {

        if {"" == [info commands ::tclreadline::readline]} {
            ::tclreadline::Init
        }

        if {[catch {set a [::tclreadline::prompt1]}] \
            && [info nameofexecutable] != ""} {

            namespace eval ::tclreadline {
                variable prompt_string
                set base [file tail [info nameofexecutable]]

                if {[string match tclsh* $base] && [info exists tcl_version]} {
                    set prompt_string \
                        "\[0;91mtclsh$tcl_version\[0m"
                } elseif {[string match wish* $base] \
                    && [info exists tk_version]} {
                    set prompt_string "\[0;94mwish$tk_version\[0m"
                } else {
                    set prompt_string "\[0;91m$base\[0m"
                }

            }

            if {"" == [info procs ::tclreadline::prompt1]} {
                proc ::tclreadline::prompt1 {} {
                    variable prompt_string
                    global env
                    if {[catch {set pwd [pwd]} tmp]} {
                        set pwd "unable to get pwd"
                    }

                    if [info exists env(HOME)] {
                        regsub $env(HOME) $pwd "~" pwd
                    }
                    return "$prompt_string \[$pwd\]"
                }
            }
            # puts body=[info body ::tclreadline::prompt1]
        }

        if {"" == [info procs exit]} {

            catch {rename ::tclreadline::Exit ""}
            rename exit ::tclreadline::Exit

            proc exit {args} {

                if {[catch {
                    ::tclreadline::readline write \
                    [::tclreadline::HistoryFileGet]
                } ::tclreadline::errorMsg]} {
                    puts stderr $::tclreadline::errorMsg
                }

                if [catch "eval ::tclreadline::Exit $args" message] {
                    puts stderr "error:"
                    puts stderr "$message"
                }
                # NOTREACHED
            }
        }

    }

    global env
    variable historyfile

    if {[string trim [llength ${args}]]} {
        set historyfile ""
        catch {
            set historyfile [file nativename [lindex ${args} 0]]
        }
        if {"" == [string trim $historyfile]} {
            set historyfile [lindex ${args} 0]
        }
    } else {
        if [info exists env(HOME)] {
            set historyfile  $env(HOME)/.tclsh-history
        } else {
            set historyfile  .tclsh-history
        }
    }
    set ::tclreadline::errorMsg [readline initialize $historyfile]
    if {$::tclreadline::errorMsg != ""} {
        puts stderr $::tclreadline::errorMsg
    }

    # InitCmds

    rename Setup ""
}

proc HistoryFileGet {} {
    variable historyfile
    return $historyfile
}

proc Glob {string} {

    set commandstring ""
    foreach name $string {
        set replace [glob -nocomplain -- $name]
        if {$replace == ""} {
            lappend commandstring $name
        } else {
            lappend commandstring $replace
        }
    }
    # return $commandstring
    # Christian Krone <krischan@sql.de> proposed
    return [eval concat $commandstring]
}



proc Loop {args} {

    eval Setup ${args}

    uplevel #0 {

        while {1} {

            if [info exists tcl_prompt2] {
                set prompt2 $tcl_prompt2
            } else {
                set prompt2 ">"
            }

            if {[catch {
                if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
                    set LINE [::tclreadline::readline read \
                    [::tclreadline::prompt1]]
                } else {
                    set LINE [::tclreadline::readline read %]
                }
                while {![::tclreadline::readline complete $LINE]} {
                    append LINE "\n"
                    append LINE [tclreadline::readline read ${prompt2}]
                }
            } ::tclreadline::errorMsg]} {
                puts stderr [list tclreadline::Loop: error. \
                $::tclreadline::errorMsg]
                continue
            }

            # Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
            # to add the line also to tclsh's history.
            #
            # I decided to add only lines which are different from
            # the previous one to the history. This is different
            # from tcsh's behaviour, but I found it quite convenient
            # while using mshell on os9.
            #
            if {[string length $LINE] && [history event 0] != $LINE} {
                history add $LINE
            }

            if [catch {
                set result [eval $LINE]
                if {$result != "" && [tclreadline::Print]} {
                    puts $result
                }
                set result ""
            } ::tclreadline::errorMsg] {
                puts stderr $::tclreadline::errorMsg
                puts stderr [list while evaluating $LINE]
            }

        }
    }
}

proc Print {args} {
    variable PRINT
    if ![info exists PRINT] {
        set PRINT yes
    }
    if [regexp -nocase \(true\|yes\|1\) $args] {
        set PRINT yes
    } elseif [regexp -nocase \(false\|no\|0\) $args] {
        set PRINT no
    }
    return $PRINT
}
# 
# 
# proc InitCmds {} {
#     # XXX
#     return 
#     # XXX

|
|







 







|
|

|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







|
|
|
|
|




|

|
|
|

|
|

|
|
|

|
|
|
|
|
|
|
|
|

|

|
|
|
|
|
|
|

|
|
|
|
|
|
|
|

|

|
|

|

|
|
|
|
|
|

|
|
|
|
|
|
|

|

|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|

|



|
|




|
|
|
|
|
|
|
|
|
|
|
|






|

|

|

|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|
|

|
|



|
|
|
|
|
|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
#!/usr/locanl/bin/tclsh
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Wed Sep 15 15:23:30 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................


# package provide tclreadline @TCLREADLINE_VERSION@
package provide tclreadline 0.9

proc unknown args {

	global auto_noexec auto_noload env unknown_pending tcl_interactive
	global errorCode errorInfo

	# Save the values of errorCode and errorInfo variables, since they
	# may get modified if caught errors occur below.  The variables will
	# be restored just before re-executing the missing command.

	set savedErrorCode $errorCode
	set savedErrorInfo $errorInfo
	set name [lindex $args 0]
	if ![info exists auto_noload] {
		#
		# Make sure we're not trying to load the same proc twice.
		#
		if [info exists unknown_pending($name)] {
			return -code error "self-referential recursion in \"unknown\" for command \"$name\""
		}
		set unknown_pending($name) pending
		set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
		unset unknown_pending($name)
		if {$ret != 0} {
			return -code $ret -errorcode $errorCode \
				"error while autoloading \"$name\": $msg"
		}
		if ![array size unknown_pending] {
			unset unknown_pending
		}
		if $msg {
			set errorCode $savedErrorCode
			set errorInfo $savedErrorInfo
			set code [catch {uplevel 1 $args} msg]
			if {$code ==  1} {
				#
				# Strip the last five lines off the error stack (they're
				# from the "uplevel" command).
				#

				set new [split $errorInfo \n]
				set new [join [lrange $new 0 [expr [llength $new] - 6]] \n]
				return -code error -errorcode $errorCode \
						-errorinfo $new $msg
			} else {
				return -code $code $msg
			}
		}
	}

	# REMOVED THE [info script] TEST (joze, SEP 98)
	if {([info level] == 1) \
			&& [info exists tcl_interactive] && $tcl_interactive} {
		if ![info exists auto_noexec] {
			set new [auto_execok $name]
			if {$new != ""} {
				set errorCode $savedErrorCode
				set errorInfo $savedErrorInfo
				set redir ""
				if {[info commands console] == ""} {
					set redir ">&@stdout <@stdin"
				}
				# LOOK FOR GLOB STUFF IN $ARGS (joze, SEP 98)
				return [uplevel eval exec $redir $new \
					[::tclreadline::Glob [lrange $args 1 end]]]
			}
		}
		set errorCode $savedErrorCode
		set errorInfo $savedErrorInfo
		if {$name == "!!"} {
			set newcmd [history event]
		} elseif {[regexp {^!(.+)$} $name dummy event]} {
			set newcmd [history event $event]
		} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
			set newcmd [history event -1]
			catch {regsub -all -- $old $newcmd $new newcmd}
		}
		if [info exists newcmd] {
			tclLog $newcmd
			history change $newcmd 0
			return [uplevel $newcmd]
		}

		set ret [catch {set cmds [info commands $name*]} msg]
		if {[string compare $name "::"] == 0} {
			set name ""
		}
		if {$ret != 0} {
			return -code $ret -errorcode $errorCode \
				"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
		}
		if {[llength $cmds] == 1} {
			return [uplevel [lreplace $args 0 0 $cmds]]
		}
		if {[llength $cmds] != 0} {
			if {$name == ""} {
				return -code error "empty command name \"\""
			} else {
				return -code error \
						"ambiguous command name \"$name\": [lsort $cmds]"
			}
		}
	}
	return -code error "invalid command name \"$name\""
}

namespace eval tclreadline {

namespace export Setup Glob Loop InitTclCmds InitTkCmds Print ls

proc ls {args} {
	if {[exec uname -s] == "Linux"} {
		eval exec ls --color -FC [Glob $args]
	} else {
		eval exec ls -FC [Glob $args]
	}
}

proc Setup {args} {

	uplevel #0 {

		if {"" == [info commands ::tclreadline::readline]} {
			::tclreadline::Init
		}

		if {[catch {set a [::tclreadline::prompt1]}] \
			&& [info nameofexecutable] != ""} {

			namespace eval ::tclreadline {
				variable prompt_string
				set base [file tail [info nameofexecutable]]

				if {[string match tclsh* $base] && [info exists tcl_version]} {
					set prompt_string \
						"\[0;91mtclsh$tcl_version\[0m"
				} elseif {[string match wish* $base] \
					&& [info exists tk_version]} {
					set prompt_string "\[0;94mwish$tk_version\[0m"
				} else {
					set prompt_string "\[0;91m$base\[0m"
				}

			}

			if {"" == [info procs ::tclreadline::prompt1]} {
				proc ::tclreadline::prompt1 {} {
					variable prompt_string
					global env
					if {[catch {set pwd [pwd]} tmp]} {
						set pwd "unable to get pwd"
					}

					if [info exists env(HOME)] {
						regsub $env(HOME) $pwd "~" pwd
					}
					return "$prompt_string \[$pwd\]"
				}
			}
			# puts body=[info body ::tclreadline::prompt1]
		}

		if {"" == [info procs exit]} {

			catch {rename ::tclreadline::Exit ""}
			rename exit ::tclreadline::Exit

			proc exit {args} {

				if {[catch {
					::tclreadline::readline write \
					[::tclreadline::HistoryFileGet]
				} ::tclreadline::errorMsg]} {
					puts stderr $::tclreadline::errorMsg
				}

				if [catch "eval ::tclreadline::Exit $args" message] {
					puts stderr "error:"
					puts stderr "$message"
				}
				# NOTREACHED
			}
		}

	}

	global env
	variable historyfile

	if {[string trim [llength ${args}]]} {
		set historyfile ""
		catch {
			set historyfile [file nativename [lindex ${args} 0]]
		}
		if {"" == [string trim $historyfile]} {
			set historyfile [lindex ${args} 0]
		}
	} else {
		if [info exists env(HOME)] {
			set historyfile  $env(HOME)/.tclsh-history
		} else {
			set historyfile  .tclsh-history
		}
	}
	set ::tclreadline::errorMsg [readline initialize $historyfile]
	if {$::tclreadline::errorMsg != ""} {
		puts stderr $::tclreadline::errorMsg
	}

	# InitCmds

	rename Setup ""
}

proc HistoryFileGet {} {
	variable historyfile
	return $historyfile
}

proc Glob {string} {

	set commandstring ""
	foreach name $string {
		set replace [glob -nocomplain -- $name]
		if {$replace == ""} {
			lappend commandstring $name
		} else {
			lappend commandstring $replace
		}
	}
	# return $commandstring
	# Christian Krone <krischan@sql.de> proposed
	return [eval concat $commandstring]
}



proc Loop {args} {

	eval Setup ${args}

	uplevel #0 {

		while {1} {

			if [info exists tcl_prompt2] {
				set prompt2 $tcl_prompt2
			} else {
				set prompt2 ">"
			}

			if {[catch {
				if {"" != [namespace eval ::tclreadline {info procs prompt1}]} {
					set LINE [::tclreadline::readline read \
					[::tclreadline::prompt1]]
				} else {
					set LINE [::tclreadline::readline read %]
				}
				while {![::tclreadline::readline complete $LINE]} {
					append LINE "\n"
					append LINE [tclreadline::readline read ${prompt2}]
				}
			} ::tclreadline::errorMsg]} {
				puts stderr [list tclreadline::Loop: error. \
				$::tclreadline::errorMsg]
				continue
			}

			# Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
			# to add the line also to tclsh's history.
			#
			# I decided to add only lines which are different from
			# the previous one to the history. This is different
			# from tcsh's behaviour, but I found it quite convenient
			# while using mshell on os9.
			#
			if {[string length $LINE] && [history event 0] != $LINE} {
				history add $LINE
			}

			if [catch {
				set result [eval $LINE]
				if {$result != "" && [tclreadline::Print]} {
					puts $result
				}
				set result ""
			} ::tclreadline::errorMsg] {
				puts stderr $::tclreadline::errorMsg
				puts stderr [list while evaluating $LINE]
			}

		}
	}
}

proc Print {args} {
	variable PRINT
	if ![info exists PRINT] {
		set PRINT yes
	}
	if [regexp -nocase \(true\|yes\|1\) $args] {
		set PRINT yes
	} elseif [regexp -nocase \(false\|no\|0\) $args] {
		set PRINT no
	}
	return $PRINT
}
# 
# 
# proc InitCmds {} {
#     # XXX
#     return 
#     # XXX