1
2
3
4
5
6
7
8
9
10
|
1
2
3
4
5
6
7
8
9
10
|
-
-
+
+
|
# -*- tclsh -*-
# FILE: "/disk01/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Wed Sep 15 18:18:13 1999 (joze)"
# FILE: "/home/joze/src/tclreadline/tclreadlineCompleter.tcl"
# LAST MODIFICATION: "Thu Sep 16 02:47:02 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999 Johannes Zellner
#
|
| ︙ | | |
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
51
52
|
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
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
|
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
# http://www.zellner.org/tclreadline/
#
# ==================================================================
# TODO:
#
# - tcltest is missing
# - tcltest is missing
# - better completion for CompleteListFromList:
# RemoveUsedOptions ...
# - namespace eval fred {... <-- continue with a
# substitution in fred.
#
#
namespace eval tclreadline {
namespace export \
TryFromList CompleteFromList DisplayHints Rehash \
PreviousWord CommandCompletion RemoveUsedOptions \
HostList ChannelId InChannelId OutChannelId \
Lindex Llength CompleteBoolean
# set tclreadline::trace to 1, if you
# want to enable explicit trace calls.
#
variable trace
# set tclreadline::trace_procs to 1, if you
# want to enable tracing every entry to a proc.
#
variable trace_procs
if {[info exists trace_procs] && $trace_procs} {
::proc proc {name arguments body} {
::proc $name $arguments [subst -nocommands {
TraceText [lrange [info level 0] 1 end]
$body
}]
}
} else { ;# !$trace_procs
catch {rename ::tclreadline::proc ""}
}
if {[info exists trace] && $trace} {
::proc TraceReconf {args} {
eval .tclreadline_trace.scroll set $args
.tclreadline_trace.text see end
}
::proc AssureTraceWindow {} {
variable trace
if {![info exists trace]} {
return 0
}
if {!$trace} {
return 0
}
if {![winfo exists .tclreadline_trace.text]} {
toplevel .tclreadline_trace
text .tclreadline_trace.text \
-yscrollcommand { tclreadline::TraceReconf }
scrollbar .tclreadline_trace.scroll \
-orient vertical \
-command { .tclreadline_trace.text yview }
pack .tclreadline_trace.text -side left -expand yes -fill both
pack .tclreadline_trace.scroll -side right -expand yes -fill y
} else {
raise .tclreadline_trace
}
return 1
}
::proc TraceVar vT {
if {![AssureTraceWindow]} {
return
}
upvar $vT v
if {[info exists v]} {
.tclreadline_trace.text insert end \
"([lindex [info level -1] 0]) $vT=|$v|\n"
}
# silently ignore unset variables.
}
::proc TraceText txt {
if {![AssureTraceWindow]} {
return
}
.tclreadline_trace.text insert end \
[format {%32s %s} ([lindex [info level -1] 0]) $txt\n]
}
} else {
::proc TraceReconf args {}
::proc AssureTraceWindow args {}
::proc TraceVar args {}
::proc TraceText args {}
}
#**
# 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.
|
| ︙ | | |
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
|
509
510
511
512
513
514
515
516
517
518
519
520
521
522
|
-
-
-
-
-
-
-
-
-
-
-
|
proc QuoteQuotes {line} {
regsub -all -- \" $line {\"} line
regsub -all -- \{ $line {\{} line; # \}\} (keep the editor happy)
return $line
}
proc Trace {varT} {
if {![info exists ::tclreadline::Debug]} {return}
upvar $varT var
if {![info exists var]} {
puts $varT=<notdefined>
} else {
puts $varT=|$var|
}
# puts $var
}
|
| ︙ | | |
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
|
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
|
-
+
+
|
return [list "\{${args}\}"]
}
}
3 {
if {![string length [Lindex $line $pos]]} {
return [list \{ {}]; # \}
} else {
return [DisplayHints <body>]
# return [DisplayHints <body>]
return [BraceOrCommand $text $start $end $line $pos $mod]
}
}
}
return ""
}
proc complete(puts) {text start end line pos mod} {
|
| ︙ | | |
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
|
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
|
+
+
+
+
+
+
+
+
|
2 {
if {"-displayof" == [PreviousWord ${start} ${line}]} {
return [CompleteFromList ${text} [ToplevelWindows]]
}
}
}
}
proc EventuallyInsertLeadingDot {text fallback} {
if {![string length ${text}]} {
return [list . {}]
} else {
return [DisplayHints $fallback]
}
}
#**
# 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'.
|
| ︙ | | |
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
|
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
|
-
+
+
+
+
|
# nothing typed so far. Insert a $pre
# and inhibit further completion.
#
return [list ${pre} {}]
} elseif {[regexp ${post} ${text}]} {
# finalize
# finalize, append the post and a space.
#
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}
}
# TraceVar left
# TraceVar right
# 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}]
} {
|
| ︙ | | |
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
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
|
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
|
-
+
-
+
-
+
-
+
+
-
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
+
-
+
-
-
+
+
-
+
-
-
+
+
-
+
-
+
|
} else {
return ${completion}
}
return ""
}
proc complete(bind) {text start end line pos mod} {
switch -- $pos {
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]]
[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]
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 [BraceOrCommand ${text} \
${start} ${end} ${line} ${pos} ${mod}]
}
}
return ""
}
proc complete(bindtags) {text start end line pos mod} {
switch -- $pos {
switch -- ${pos} {
1 { return [CompleteFromList ${text} [WidgetChildren ${text}]] }
2 {
return [CompleteListFromList ${text} [Lindex $line 2] \
[bindtags [Lindex $line 1]] \{ { } \}]
return [CompleteListFromList ${text} [Lindex ${line} 2] \
[bindtags [Lindex ${line} 1]] \{ { } \}]
}
}
return ""
}
proc CompleteWidgetConfigurations {text start line lst} {
prev [PreviousWord ${start} ${line}]
}
proc complete(button) {text start end line pos mod} {
switch -- ${pos} {
1 { return [EventuallyInsertLeadingDot ${text} <pathName>] }
default {
return [CompleteWidgetConfigurations ${text} {
}]
}
}
return ""
}
proc complete(image) {text start end line pos mod} {
set sub [Lindex $line 1]
switch -- $pos {
set sub [Lindex ${line} 1]
switch -- ${pos} {
1 { return [CompleteFromList ${text} [TrySubCmds image]] }
2 {
switch -- $sub {
switch -- ${sub} {
create { return [CompleteFromList ${text} [image types]] }
delete -
height -
type -
width { return [CompleteFromList ${text} [image names]] }
names {}
types {}
}
}
3 {
switch -- $sub {
switch -- ${sub} {
create {
set type [Lindex $line 2]
switch -- $type {
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 {
switch -- ${sub} {
create {
set type [Lindex $line 2]
set prev [PreviousWord $start $line]
set type [Lindex ${line} 2]
set prev [PreviousWord ${start} ${line}]
# puts stderr prev=$prev
switch -- $type {
switch -- ${type} {
bitmap {
switch -- $prev {
switch -- ${prev} {
-background -
-foreground { return [DisplayHints <color>] }
-data -
-maskdata { return [DisplayHints <string>] }
-file -
-maskfile { return "" }
default {
|
| ︙ | | |
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
|
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
|
-
+
|
}
}
}
}
proc complete(winfo) {text start end line pos mod} {
set cmd [lindex ${line} 1]
switch -- $pos {
switch -- ${pos} {
1 {
set cmds [TrySubCmds winfo]
if {[llength ${cmds}]} {
return [TryFromList ${text} ${cmds}]
}
}
2 {
|
| ︙ | | |