Diff
Not logged in

Differences From Artifact [7817716c44]:

To Artifact [99e76e529e]:


1
2
3


4
5
6
7
8
9
10
1


2
3
4
5
6
7
8
9
10

-
-
+
+







#!/usr/locanl/bin/tclsh
# FILE: "/home/joze/src/tclreadline/tclreadlineSetup.tcl.in"
# LAST MODIFICATION: "Fri Sep  3 16:16:44 1999 (joze)"
# 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
#
742
743
744
745
746
747
748
749

750
751
752
753
754
755
756
742
743
744
745
746
747
748

749
750
751
752
753
754
755
756







-
+







                    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]
                    $start $end $line $pos $mod]] ::tclreadline::errorMsg]
                } {
                    error "error during evaluation of `complete(${cmd})'"
                }
                return ${script_result}
            }
        }
        # no specific command completer found.
788
789
790
791
792
793
794
795

796
797
798
799




800
801
802
803
804
805
806
788
789
790
791
792
793
794

795
796



797
798
799
800
801
802
803
804
805
806
807







-
+

-
-
-
+
+
+
+







        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]} {
                if {[string match tclsh* $base] && [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"
                        "\[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]} {
826
827
828
829
830
831
832
833
834


835
836
837
838
839
840
841
827
828
829
830
831
832
833


834
835
836
837
838
839
840
841
842







-
-
+
+







            rename exit ::tclreadline::Exit

            proc exit {args} {

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

                if [catch "eval ::tclreadline::Exit $args" message] {
                    puts stderr "error:"
                    puts stderr "$message"
                }
                # NOTREACHED
858
859
860
861
862
863
864
865
866
867



868
869
870
871
872
873
874
859
860
861
862
863
864
865



866
867
868
869
870
871
872
873
874
875







-
-
-
+
+
+







    } 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"
    set ::tclreadline::errorMsg [readline initialize $historyfile]
    if {$::tclreadline::errorMsg != ""} {
        puts stderr $::tclreadline::errorMsg
    }

    InitCmds

    rename Setup ""
}

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







-
-
+
+
+












-
-
+
+







                } 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]
            } ::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 ""
            } msg] {
                puts stderr $msg
            } ::tclreadline::errorMsg] {
                puts stderr $::tclreadline::errorMsg
                puts stderr [list while evaluating $LINE]
            }

        }
    }
}

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







-
+














+
+
+
+
+
+
+
+
+
+




-
+








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

# generic widget configuration

proc TrySubCmds cmd {
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}]} {