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