Check-in [7d8cdbb1ff]
Not logged in
Overview
Comment: .csymrc .login .tclshrc .vimrc vim xyz-stereo tcl_ft.vim HKLlink.h hkl.h tclreadlineSetup.tcl.in
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:7d8cdbb1ff72e2b5e045dac116be3aae723f63e0
User & Date: johannes@zellner.org on 1999-09-04 08:48:11
Other Links: manifest | tags
Context
1999-09-06
06:58
TODO tclreadlineSetup.tcl.in check-in: c7a9a1576d user: johannes@zellner.org tags: trunk, CVS
1999-09-04
08:48
.csymrc .login .tclshrc .vimrc vim xyz-stereo tcl_ft.vim HKLlink.h hkl.h tclreadlineSetup.tcl.in check-in: 7d8cdbb1ff user: johannes@zellner.org tags: trunk
1999-09-03
18:00
Modified Files: .csymrc include/zellner/StdVector.h src/csym/.csymrc src/csym/csym.cc src/tclreadline/tclreadlineSetup.tcl.in Added Files: src/csym/version src/tclreadline/Makefile.in src/tclreadline/tclreadline.c src/tclreadline/tclreadlineConfig.sh.in src/tclreadline/tclreadlineInit.tcl.in check-in: 99d8d2b9c5 user: johannes@zellner.org tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified tclreadlineSetup.tcl.in from [7817716c44] to [99e76e529e].

1
2
3
4
5
6
7
8
9
10
...
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
...
788
789
790
791
792
793
794
795
796
797

798
799
800
801
802
803
804
805
806
...
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
...
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
...
916
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
....
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
....
2167
2168
2169
2170
2171
2172
2173










2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Fri Sep  3 16:16:44 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
                    set mod [string range $part 1 end]
                } else {
                    set mod $part
                }

                if {[catch [list set script_result \
                    [complete(${cmd}) $part \
                    $start $end $line $pos $mod]] msg]
                } {
                    error "error during evaluation of `complete(${cmd})'"
                }
                return ${script_result}
            }
        }
        # no specific command completer found.
................................................................................
        if {[catch {set a [::tclreadline::prompt1]}] \
            && [info nameofexecutable] != ""} {

            namespace eval ::tclreadline {
                variable prompt_string
                set base [file tail [info nameofexecutable]]

                if {$base == "tclsh" && [info exists tcl_version]} {
                    set prompt_string \
                        "\[0;91m$base$tcl_version\[0m"

                } elseif {$base == "wish" && [info exists tk_version]} {
                    set prompt_string "\[0;94m$base$tk_version\[0m"
                } else {
                    set prompt_string "\[0;91m$base\[0m"
                }

            }

            if {"" == [info procs ::tclreadline::prompt1]} {
................................................................................
            rename exit ::tclreadline::Exit

            proc exit {args} {

                if {[catch {
                    ::tclreadline::readline write \
                    [::tclreadline::HistoryFileGet]
                } msg]} {
                    puts stderr $msg
                }

                if [catch "eval ::tclreadline::Exit $args" message] {
                    puts stderr "error:"
                    puts stderr "$message"
                }
                # NOTREACHED
................................................................................
    } else {
        if [info exists env(HOME)] {
            set historyfile  $env(HOME)/.tclsh-history
        } else {
            set historyfile  .tclsh-history
        }
    }
    set msg [readline initialize $historyfile]
    if {$msg != ""} {
        puts stderr "$msg"
    }

    InitCmds

    rename Setup ""
}

................................................................................
                } else {
                    set LINE [::tclreadline::readline read %]
                }
                while {![::tclreadline::readline complete $LINE]} {
                    append LINE "\n"
                    append LINE [tclreadline::readline read ${prompt2}]
                }
            } msg]} {
                puts stderr [list tclreadline::Loop: error. $msg]

                continue
            }

            # Magnus Eriksson <magnus.eriksson@netinsight.se> proposed
            history add $LINE

            if [catch {
                set result [eval $LINE]
                if {$result != "" && [tclreadline::Print]} {
                    puts $result
                }
                set result ""
            } msg] {
                puts stderr $msg
                puts stderr [list while evaluating $LINE]
            }

        }
    }
}

................................................................................

# -------------------------------------
#                  TK
# -------------------------------------

# generic widget configuration

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

            }










        }
    }
    return ${result}
}
        
proc WidgetList {pattern} {
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {[winfo exists ${pattern}]} {
        return [winfo children ${pattern}]
    } else {
        regsub {.[^.]*$} $pattern {} pattern
        if {[winfo exists ${pattern}]} {

|
|







 







|







 







|

|
>
|
|







 







|
|







 







|
|
|







 







|
|
>












|
|







 







|







 







>
>
>
>
>
>
>
>
>
>




|







1
2
3
4
5
6
7
8
9
10
...
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
...
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
...
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
...
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
....
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
....
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
#!/usr/locanl/bin/tclsh
# FILE: "/diska/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Sat Sep  4 07:35:09 1999 (joze)"
# (C) 1998, 1999 by Johannes Zellner, <johannes@zellner.org>
# $Id$
# ---
#
# tclreadline -- gnu readline for tcl
# Copyright (C) 1999  Johannes Zellner
#
................................................................................
                    set mod [string range $part 1 end]
                } else {
                    set mod $part
                }

                if {[catch [list set script_result \
                    [complete(${cmd}) $part \
                    $start $end $line $pos $mod]] ::tclreadline::errorMsg]
                } {
                    error "error during evaluation of `complete(${cmd})'"
                }
                return ${script_result}
            }
        }
        # no specific command completer found.
................................................................................
        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]} {
................................................................................
            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
................................................................................
    } 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 ""
}

................................................................................
                } 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
            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]
            }

        }
    }
}

................................................................................

# -------------------------------------
#                  TK
# -------------------------------------

# generic widget configuration

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

proc WidgetList {pattern} {
    regsub {^([^\.])} ${pattern} {\.\1} pattern
    if {[winfo exists ${pattern}]} {
        return [winfo children ${pattern}]
    } else {
        regsub {.[^.]*$} $pattern {} pattern
        if {[winfo exists ${pattern}]} {