1
2
3
4
5
6
7
8
9
10
11
12
|
1
2
3
4
5
6
7
8
9
10
11
12
|
-
-
+
+
|
/* ==================================================================
FILE: "/diska/home/joze/src/tclreadline/tclreadline.c"
LAST MODIFICATION: "Tue Sep 14 11:57:42 1999 (joze)"
FILE: "/home/joze/src/tclreadline/tclreadline.c"
LAST MODIFICATION: "Wed Sep 15 01:00:43 1999 (joze)"
(C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
$Id$
---
tclreadline -- gnu readline for tcl
Copyright (C) 1999 Johannes Zellner
|
︙ | | |
642
643
644
645
646
647
648
649
650
651
652
653
654
655
|
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
|
+
|
int i, length;
matches = (char**) MALLOC(sizeof(char*) * (objc + 1));
for (i = 0; i < objc; i++) {
matches[i] = strdup(Tcl_GetStringFromObj(objv[i], &length));
if (1 == objc && !strlen(matches[i])) {
FREE(matches[i]);
FREE(matches);
Tcl_ResetResult(tclrl_interp); /* clear result space */
return (char**) NULL;
}
}
/**
* this is a special one:
* if the script returns exactly two arguments
|
︙ | | |
1
2
3
4
5
6
7
8
9
10
|
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)"
# 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
#
|
︙ | | |
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
|
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
|
+
+
+
-
+
-
+
-
+
+
+
+
+
+
-
+
+
+
-
-
+
+
|
#**
# TryFromList will return an empty string, if
# the text typed so far does not match any of the
# elements in list. This might be used to allow
# subsequent filename completion by the builtin
# completer.
# If inhibit is non-zero, the result will be
# formatted such that readline will not insert
# a space after a complete (single) match.
#
proc TryFromList {text lst {allow ""}} {
proc TryFromList {text lst {allow ""} {inhibit 0}} {
# puts stderr "(CompleteFromList) \ntext=|$text|"
# puts stderr "(CompleteFromList) lst=|$lst|"
set pre [GetQuotedPrefix ${text}]
set matches [MatchesFromList $text $lst $allow]
# puts stderr "(CompleteFromList) matches=|$matches|"
if {1 == [llength $matches]} { ; # unique match
# puts stderr \nunique=$matches\n
# puts stderr "\n|${pre}${matches}[Right ${pre}]|\n"
set null [string index $matches 0]
if {"<" == $null || "?" == $null} {
return [string trim "[list $text] $lst"]
set completion [string trim "[list $text] $lst"]
} else {
return [string trim ${pre}${matches}[Right ${pre}]]
set completion [string trim ${pre}${matches}[Right ${pre}]]
}
if {$inhibit} {
return [list $completion {}]
} else {
return $completion
}
} elseif {"" != ${matches}} {
# puts stderr \nmore=$matches\n
set longest [CompleteLongest ${matches}]
# puts stderr longest=|$longest|
if {"" == $longest} {
return [string trim "[list $text] ${matches}"]
} else {
return [string trim "${pre}${longest} ${matches}"]
}
} else {
return ""; # nothing to complete
}
}
#**
# CompleteFromList will never return an empty string.
# completes, if a completion can be done, or ring
# the bell if not.
# the bell if not. If inhibit is non-zero, the result
# will be formatted such that readline will not insert
# a space after a complete (single) match.
#
proc CompleteFromList {text lst} {
set result [TryFromList ${text} ${lst}]
proc CompleteFromList {text lst {inhibit 0}} {
set result [TryFromList ${text} ${lst} "" $inhibit]
if {![llength ${result}]} {
Alert
# return [string trim [list ${text}] ${lst}"]
if {[llength ${lst}]} {
return [string trim "${text} ${lst}"]
} else {
return [string trim [list ${text} {}]]
|
︙ | | |
893
894
895
896
897
898
899
900
901
902
903
904
905
906
|
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
|
+
|
} else {
# try to use $pos further ...
# puts stderr |$line|
#
if {"." == [string index [string trim ${line}] 0]} {
set alias WIDGET
set namespc ""
} else {
# the double `lindex' strips {} or quotes.
# the subst enables variables containing
# command names.
#
set alias [uplevel [info level] \
|
︙ | | |
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
|
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
|
-
-
+
+
|
}
}
default {
set sub [Lindex $line 1]
switch -- $sub {
configure -
cget {
if {[OptionTable ${widget} options]} {
}
return [CompleteFromOptions \
${part} ${start} ${line} ${alias}]
}
}
}
}
# no specific command completer found.
|
︙ | | |
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
|
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
|
+
+
+
+
+
-
+
|
atan exp log10 tan
atan2 floor pow tanh
ceil fmod sin abs
double int rand round
srand
}
if {[info tclversion] >= 8.2} {
set end end
} else {
set end [expr [string length $text] - 1]
}
if {")" == [string index $text end] && -1 != [lsearch $cmds $left]} {
if {")" == [string index $text $end] && -1 != [lsearch $cmds $left]} {
return "$text "; # append a space after a closing ')'
}
switch -- $left {
rand { return "rand() " }
abs -
|
︙ | | |
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
|
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
|
-
+
+
+
+
|
switch -- $cmd {
children -
export -
forget -
import { return [DisplayHints ?pattern?] }
delete { return [TryFromList ${mod} $space_matches] }
eval -
inscope { return [DisplayHints <arg>] }
inscope {
return [BraceOrControlStatement \
$text $start $end $line $pos $mod]
}
which { return [CompleteFromList ${mod} {-variable <name>}] }
}
}
4 {
switch -- $cmd {
export -
forget -
|
︙ | | |
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
|
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
|
-
+
-
+
-
+
-
+
|
# -------------------------------------
# TK
# -------------------------------------
# GENERIC WIDGET CONFIGURATION
proc WidgetChildren {pattern} {
proc WidgetChildren {{pattern .}} {
regsub {^([^\.])} ${pattern} {\.\1} pattern
if {![string length ${pattern}]} {
set pattern .
}
if {[winfo exists ${pattern}]} {
return [winfo children ${pattern}]
return [concat ${pattern} [winfo children ${pattern}]]
} else {
regsub {.[^.]*$} $pattern {} pattern
if {[winfo exists ${pattern}]} {
return [winfo children ${pattern}]
return [concat ${pattern} [winfo children ${pattern}]]
} else {
return ""
}
}
}
proc WidgetDescendants {pattern} {
proc WidgetDescendants {{pattern .}} {
set tree [WidgetChildren ${pattern}]
foreach widget $tree {
append tree " [WidgetDescendants $widget]"
}
return $tree
}
|
︙ | | |
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
|
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
|
-
+
-
+
-
-
-
+
+
+
-
-
-
-
+
-
-
-
+
+
+
-
-
-
+
+
+
+
+
+
+
+
-
+
+
+
-
+
+
-
-
+
+
-
-
+
|
# @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]} {
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]
}
}
return [llength ${option_table}
return [llength ${option_table}]
}
#**
# :xa
# @param
# @return
# 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.
# @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 {0 < [OptionTable ${cmd} options]} {
if {-1 != [set found \
[lsearch -exact $options(switches) ${prev}]]
} {
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 "[lindex $options(value) ${found}]"]
return [list [list [lindex $options(value) ${found}]]]
}
} else {
return [CompleteFromList ${text} \
return [TryFromList ${text} $options(switches)]
[RemoveUsedOptions $line $options(switches)]]
}
}
}
proc complete(WIDGET) {text start end line pos mod} {
set widget [lindex ${line} 0]
set cmd [lindex ${line} 1]
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 {
default {
if {([string match ${cmd}* cget] || \
[string match ${cmd}* configure])
} {
return [CompleteFromOptions ${text} ${start} ${line} ${widget}]
}
}
}
|
︙ | | |
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
|
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
|
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
if {"-displayof" == [PreviousWord ${start} ${line}]} {
return [CompleteFromList ${text} [ToplevelWindows]]
}
}
}
}
# proc complete(bind) {text start end line pos mod} {
# TODO
# 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}]
# 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]
switch -- $pos {
1 { return [CompleteFromList ${text} [TrySubCmds image]] }
2 {
switch -- $sub {
|
︙ | | |