Diff
Not logged in

Differences From Artifact [17e4a4595b]:

To Artifact [d3c3f77ed1]:


1
2
3


4
5
6
7
8
9
10
1


2
3
4
5
6
7
8
9
10

-
-
+
+







# -*- tclsh -*-
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 02:59:18 1999 (joze)"
# 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
#
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
28
29
30
31
32
33
34

35
36
37
38
39
40
41







-







# ================================================================== 


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



namespace eval tclreadline {

namespace export \
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
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







-
+
+











+
+
+
+





-
-
+
+
+







# @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 [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 "${cmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]} {
				if {[regexp "${tcmd}\[ \t\]\+\(\[^ \t\]*\)\[^:\]*$" \
					${line} all sub]
				} {
					lappend result [list ${sub}]
				}
			}
		}
	}
	return ${result}
}
672
673
674
675
676
677
678
679

680
681
682
683
684
685
686
677
678
679
680
681
682
683

684
685
686
687
688
689
690
691







-
+







		return ${pre}${res}
	} else {
		return ${res}
	}
	return ""
}

proc BraceOrControlStatement {text start end line pos mod} {
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 ""
		}
786
787
788
789
790
791
792
793


794
795
796
797
798
799
800
791
792
793
794
795
796
797

798
799
800
801
802
803
804
805
806







-
+
+







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

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
987
988
989
990
991
992
993


994
995
996

997













998









999
1000
1001
1002
1003
1004
1005







-
-
+
+
+
-

-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-







					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
		# try to complete from the option table if the subcommand
		# is `configure' or `cget' otherwise try to get further
		# subcommands.
		# 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 \
		return [CompleteFromOptionsOrSubCmds $part $start $end $line $pos]
						${part} ${start} ${line} ${alias}]
					}
				}
			}
		}


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


# explicit command completers
#
1541
1542
1543
1544
1545
1546
1547
1548

1549
1550
1551
1552
1553
1554
1555
1526
1527
1528
1529
1530
1531
1532

1533
1534
1535
1536
1537
1538
1539
1540







-
+








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

proc complete(foreach) {text start end line pos mod} {
	switch -- $pos {
1744
1745
1746
1747
1748
1749
1750
1751

1752
1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1729
1730
1731
1732
1733
1734
1735

1736
1737
1738
1739
1740
1741
1742
1743

1744
1745
1746
1747
1748
1749
1750
1751







-
+







-
+







	# 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]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
		default {
			set prev [PreviousWord ${start} ${line}]
			switch -- $prev {
				then -
				else -
				elseif {
					return [BraceOrControlStatement \
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				default {
					if {-1 == [lsearch [ProperList $line] else]} {
						return [CompleteFromList $text {else elseif}]
					}
				}
2279
2280
2281
2282
2283
2284
2285
2286

2287
2288
2289
2290
2291
2292
2293
2264
2265
2266
2267
2268
2269
2270

2271
2272
2273
2274
2275
2276
2277
2278







-
+







				children -
				export -
				forget -
				import { return [DisplayHints ?pattern?] }
				delete { return [TryFromList ${mod} $space_matches] }
				eval -
				inscope {
					return [BraceOrControlStatement \
					return [BraceOrCommand \
					$text $start $end $line $pos $mod]
				}
				which { return [CompleteFromList ${mod} {-variable <name>}] }
			}
		}
		4 {
			switch -- $cmd {
3082
3083
3084
3085
3086
3087
3088
3089

3090
3091
3092
3093
3094
3095
3096
3067
3068
3069
3070
3071
3072
3073

3074
3075
3076
3077
3078
3079
3080
3081







-
+







	return ""
}

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

# -------------------------------------
#                  TK
3143
3144
3145
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
3128
3129
3130
3131
3132
3133
3134

3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
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
3303
3304
3305
3306
3307
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







-
+

















-
+

+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+


+














-
+


+


-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+





-
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



















-
-
-
-
-
-
-
-
-
-
-
-
-














-
+
-
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+







# @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]} {
	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]
		}
	}
	return [llength ${option_table}]
}

#**
# 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} {
proc CompleteFromOptions {text start line} {

	# check if either `configure' or `cget' is present.
	#
	set prev [PreviousWord ${start} ${line}]

	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)]]
			[RemoveUsedOptions ${line} $options(switches)]]
		}
	}
	return ""
}

proc complete(WIDGET) {text start end line pos mod} {
proc CompleteFromOptionsOrSubCmds {text start end line pos} {
	set widget [Lindex ${line} 0]
	set cmd [Lindex ${line} 1]
	switch -- $pos {
		1 {
			set cmds [TrySubCmds ${widget}]
			if {[llength ${cmds}]} {
				return [TryFromList ${mod} ${cmds}]
			}
		}
	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}]
		}
	}
		default {
			if {([string match ${cmd}* cget] || \
				[string match ${cmd}* configure])
			} {
				return [CompleteFromOptions ${text} ${start} ${line} ${widget}]
			}
		}
	}
	return ""
	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 {
	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 .]}]} {
				set toplevelClass ""
			}
			set rest {
				Button Canvas Checkbutton Entry Frame Label
				Listbox Menu Menubutton Message Radiobutton
				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}]
			return [CompleteListFromList ${text} \
			# TODO this is awkward. Think of making it better!
			#
			if {1 == [llength ${exact_matches}] && \
				-1 != [lsearch ${sequence} ${right}]
			} {
			[Lindex $line 2] ${sequence} < - >]
		}
		3 {
				set completion [CompleteFromList ${right} {> -} 1]
			} else {
				set completion [CompleteFromList ${right} $sequence 1]
			}
			# return [DisplayHints {<script> <+script>}]
			return [BraceOrCommand $text $start $end $line $pos $mod]
		}
			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(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]