1
2
3
4
5
6
7
8
9
10
|
#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Tue Sep 14 01:55:17 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999 Johannes Zellner
#
|
|
|
|
|
1
2
3
4
5
6
7
8
9
10
|
# -*- tclsh -*-
# FILE: "/diska/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Tue Sep 14 16:17:25 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999 Johannes Zellner
#
|
︙ | | | ︙ | |
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
|
# as we've reached here no valid specific completer
# was found. Check, if it's a proc and return the
# arguments.
#
if {[string length [uplevel [info level] info proc $alias]]} {
set args [uplevel [info level] info args $alias]
set arg [lindex $args [expr $pos - 1]]
if {"" != $arg} {
if {[uplevel [info level] info default $alias $arg junk]} {
return [DisplayHints ?$arg?]
} else {
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.
#
switch -- $pos {
1 {
set cmds [TrySubCmds ${alias}]
if {[llength ${cmds}]} {
return [TryFromList ${part} ${cmds}]
}
}
}
# no specific command completer found.
return ""
}
|
|
>
>
>
>
>
>
>
>
>
>
>
>
|
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
|
# as we've reached here no valid specific completer
# was found. Check, if it's a proc and return the
# arguments.
#
if {[string length [uplevel [info level] info proc $alias]]} {
set args [uplevel [info level] info args $alias]
set arg [lindex $args [expr $pos - 1]]
if {"" != $arg && "args" != $arg} {
if {[uplevel [info level] info default $alias $arg junk]} {
return [DisplayHints ?$arg?]
} else {
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 {
if {[OptionTable ${widget} options]} {
}
}
}
}
}
# no specific command completer found.
return ""
}
|
︙ | | | ︙ | |
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
|
eval -
exists -
expose -
hide -
hidden -
invokehidden -
marktrusted -
target { return [DisplayHints [interp slaves]] }
aliases -
delete -
issafe -
slaves { return [DisplayHints [interp slaves]] }
alias -
share -
transfer { return [DisplayHints <srcPath>] }
}
}
3 {
|
|
|
|
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
|
eval -
exists -
expose -
hide -
hidden -
invokehidden -
marktrusted -
target { return [CompleteFromList ${text} [interp slaves]] }
aliases -
delete -
issafe -
slaves { return [CompleteFromList ${text} [interp slaves]] }
alias -
share -
transfer { return [DisplayHints <srcPath>] }
}
}
3 {
|
︙ | | | ︙ | |
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
|
return [CompleteFromList $text "$cmds ?path?"]
} else {
return [DisplayHints ?path?]
}
}
eval { return [DisplayHints <arg>] }
delete { return [DisplayHints [interp slaves]] }
expose { return [DisplayHints <hiddenName>] }
hide { return [DisplayHints <exposedCmdName>] }
invokehidden {
return \
[CompleteFromList $text {?-global? <hiddenCmdName>}]
|
|
|
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
|
return [CompleteFromList $text "$cmds ?path?"]
} else {
return [DisplayHints ?path?]
}
}
eval { return [DisplayHints <arg>] }
delete { return [CompleteFromList ${text} [interp slaves]] }
expose { return [DisplayHints <hiddenName>] }
hide { return [DisplayHints <exposedCmdName>] }
invokehidden {
return \
[CompleteFromList $text {?-global? <hiddenCmdName>}]
|
︙ | | | ︙ | |
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
|
}
}
expose { return [DisplayHints ?exposedCmdName?] }
hide { return [DisplayHints ?hiddenCmdName?] }
share -
transfer { return [DisplayHints [interp slaves]] }
}
}
5 {
switch -- $cmd {
alias { return [DisplayHints <targetCmd>] }
invokehidden -
eval { return [DisplayHints ?arg?] }
expose { return [DisplayHints ?exposedCmdName?] }
hide { return [DisplayHints ?hiddenCmdName?] }
share -
transfer { return [DisplayHints [interp slaves]] }
}
}
}
return ""
}
proc complete(join) {text start end line pos mod} {
|
|
|
|
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
|
}
}
expose { return [DisplayHints ?exposedCmdName?] }
hide { return [DisplayHints ?hiddenCmdName?] }
share -
transfer { return [CompleteFromList ${text} [interp slaves]] }
}
}
5 {
switch -- $cmd {
alias { return [DisplayHints <targetCmd>] }
invokehidden -
eval { return [DisplayHints ?arg?] }
expose { return [DisplayHints ?exposedCmdName?] }
hide { return [DisplayHints ?hiddenCmdName?] }
share -
transfer { return [CompleteFromList ${text} [interp slaves]] }
}
}
}
return ""
}
proc complete(join) {text start end line pos mod} {
|
︙ | | | ︙ | |
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
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
|
set tree [WidgetChildren ${pattern}]
foreach widget $tree {
append tree " [WidgetDescendants $widget]"
}
return $tree
}
proc complete(WIDGET) {text start end line pos mod} {
set widget [lindex ${line} 0]
set cmd [lindex ${line} 1]
# first we build an option table
#
if {[catch [list set option_table [${widget} configure]] msg]} {
return ""
}
foreach optline ${option_table} {
if {5 != [llength ${optline}]} continue else {
lappend options(switches) [lindex ${optline} 0]
lappend options(value) [lindex ${optline} 4]
}
}
switch -- $pos {
1 {
set cmds [TrySubCmds ${widget}]
if {[llength ${cmds}]} {
return [TryFromList ${mod} ${cmds}]
}
}
2 {
if {([string match ${cmd}* cget] || \
[string match ${cmd}* configure])
} {
set prev [PreviousWord ${start} ${line}]
#puts \nprev=|$prev|
#puts switches=|$options(switches)|
#puts found=[lsearch -exact ${prev} $options(switches)]
if {-1 != [set found \
[lsearch -exact $options(switches) ${prev}]]
} {
if {![llength ${mod}]} {
return [list "[lindex $options(value) ${found}]"]
}
} else {
return [TryFromList ${mod} $options(switches)]
}
}
}
}
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} [WidgetDescendants ${text}]]
}
}
}
}
proc complete(winfo) {text start end line pos mod} {
set cmd [lindex ${line} 1]
|
|
>
>
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
|
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
<
<
<
<
<
<
<
<
<
<
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
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
|
set tree [WidgetChildren ${pattern}]
foreach widget $tree {
append tree " [WidgetDescendants $widget]"
}
return $tree
}
proc ToplevelWindows {} {
set children [WidgetChildren ""]
set toplevels ""
foreach widget $children {
set toplevel [winfo toplevel $widget]
if {-1 == [lsearch $toplevels $toplevel]} {
lappend toplevels $toplevel
}
}
return $toplevels
}
#**
# try to get options for commands which
# allow `configure' (cget).
# @param command.
# @param optionsT where the table will be stored.
# @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 [${widget} 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]
}
}
return [llength ${option_table}
}
#**
# :xa
# @param
# @return
# @warning
# @sa
# @author Johannes Zellner
# @date Sep-14-1999
#
proc CompleteFromOptions {text start line cmd} {
OptionTable ${widget} options
set prev [PreviousWord ${start} ${line}]
#puts \nprev=|$prev|
#puts switches=|$options(switches)|
#puts found=[lsearch -exact ${prev} $options(switches)]
if {-1 != [set found \
[lsearch -exact $options(switches) ${prev}]]
} {
if {![llength ${text}]} {
return [list "[lindex $options(value) ${found}]"]
}
} else {
return [TryFromList ${text} $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}]
}
}
2 {
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} {
# TODO
# return ""
# }
proc complete(image) {text start end line pos mod} {
set sub [Lindex $line 1]
switch -- $pos {
1 { return [CompleteFromList ${text} [TrySubCmds image]] }
2 {
switch -- $sub {
create { return [CompleteFromList ${text} [image types]] }
delete -
height -
type -
width { return [CompleteFromList ${text} [image names]] }
names {}
types {}
}
}
3 {
switch -- $sub {
create {
set type [Lindex $line 2]
switch -- $type {
bitmap {
return [CompleteFromList ${text} {
?name? -background -data -file
-foreground -maskdata -maskfile
}]
}
photo {
# TODO
}
default {}
}
}
default {}
}
}
default {
switch -- $sub {
create {
set type [Lindex $line 2]
set prev [PreviousWord $start $line]
# puts stderr prev=$prev
switch -- $type {
bitmap {
switch -- $prev {
-background -
-foreground { return [DisplayHints <color>] }
-data -
-maskdata { return [DisplayHints <string>] }
-file -
-maskfile { return "" }
default {
return [CompleteFromList ${text} \
[RemoveUsedOptions ${line} {
-background -data -file
-foreground -maskdata -maskfile
}]]
}
}
}
photo {
# TODO
}
}
}
}
}
}
}
proc complete(winfo) {text start end line pos mod} {
set cmd [lindex ${line} 1]
|
︙ | | | ︙ | |