← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to tcl/scipadsources/db_watch.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
tcl/scipadsources/db_watch.tcl
 
1
proc showwatch_bp {} {
 
2
    global pad watch lang env
 
3
    global lbvarname lbvarval scrolly buttonAdd
 
4
    global watchvars watchvarsvals
 
5
    global firsttimeinshowwatch watchgeom
 
6
    set watch $pad.watch
 
7
    catch {destroy $watch}
 
8
    toplevel $watch
 
9
    wm title $watch "Watch"
 
10
    if { $firsttimeinshowwatch == "true" } { 
 
11
        setwingeom $watch
 
12
    } else {
 
13
        wm resizable $watch 0 0
 
14
        wm geometry $watch $watchgeom
 
15
    }
 
16
    frame $watch.f
 
17
 
 
18
    frame $watch.f.f2
 
19
    frame $watch.f.f2.f2l
 
20
    if {$lang == "eng"} {
 
21
        set tl "Variable name:"
 
22
    } else {
 
23
        set tl "Nom de la variable :"
 
24
    }
 
25
    label $watch.f.f2.f2l.label -text $tl
 
26
    if {$lang == "eng"} {
 
27
        set bl "Add/Change"
 
28
    } else {
 
29
        set bl "Ajouter/Modifier"
 
30
    }
 
31
    set buttonAdd $watch.f.f2.f2l.buttonAdd
 
32
    button $buttonAdd -text $bl -width 20 -underline 0
 
33
    if {$lang == "eng"} {
 
34
        set bl "Remove"
 
35
    } else {
 
36
        set bl "Supprimer"
 
37
    }
 
38
    set buttonRemove $watch.f.f2.f2l.buttonRemove
 
39
    button $buttonRemove -text $bl -width 20 -underline 0
 
40
    pack $watch.f.f2.f2l.label $buttonAdd $buttonRemove -pady 4
 
41
    frame $watch.f.f2.f2r
 
42
    set lbvarname $watch.f.f2.f2r.lbvarname
 
43
    set lbvarval $watch.f.f2.f2r.lbvarval
 
44
    $buttonAdd configure -command {Addarg_bp $watch $lbvarname $lbvarval; \
 
45
                                   closewatch_bp $watch nodestroy}
 
46
    $buttonRemove configure -command {Removearg_bp $lbvarname $lbvarval; \
 
47
                                      closewatch_bp $watch nodestroy}
 
48
    set scrolly $watch.f.f2.f2r.yscroll
 
49
    scrollbar $scrolly -command "scrollyboth_bp $lbvarname $lbvarval"
 
50
    listbox $lbvarname -height 6 -yscrollcommand \
 
51
                       "scrollyrightandscrollbar_bp $scrolly $lbvarname $lbvarval" \
 
52
                       -takefocus 0
 
53
    listbox $lbvarval -height 6 -yscrollcommand \
 
54
                      "scrollyleftandscrollbar_bp $scrolly $lbvarname $lbvarval" \
 
55
                      -takefocus 0
 
56
    if {[info exists watchvars]} {
 
57
        foreach var $watchvars {
 
58
            $lbvarname insert end $var
 
59
            $lbvarval insert end $watchvarsvals($var)
 
60
        }
 
61
        $lbvarname selection set 0
 
62
        $lbvarname see 0
 
63
    }
 
64
    pack $lbvarname $scrolly $lbvarval -side left \
 
65
            -expand 1 -fill both -padx 2
 
66
    pack $watch.f.f2.f2l $watch.f.f2.f2r -side left -padx 10
 
67
    pack $watch.f.f2 -pady 4
 
68
 
 
69
    frame $watch.f.f9
 
70
    if {$lang == "eng"} {
 
71
        set bl "Close"
 
72
    } else {
 
73
        set bl "Fermer"
 
74
    }
 
75
    button $watch.f.f9.buttonClose -text $bl -command "closewatch_bp $watch"\
 
76
           -width 10 -height 1 -underline 0
 
77
    pack $watch.f.f9.buttonClose
 
78
    pack $watch.f.f9 -pady 4
 
79
 
 
80
    pack $watch.f
 
81
    bind $watch <Return> {Addarg_bp $watch $lbvarname $lbvarval; \
 
82
                          closewatch_bp $watch nodestroy}
 
83
    bind $lbvarname <Double-Button-1> {Addarg_bp $watch $lbvarname $lbvarval; \
 
84
                                       closewatch_bp $watch nodestroy}
 
85
    bind $watch <Escape> {set watchgeom [string trimleft [eval {wm geometry $watch}] 1234567890x];
 
86
                          closewatch_bp $watch}
 
87
    bind $watch <BackSpace> {Removearg_bp $lbvarname $lbvarval; \
 
88
                             closewatch_bp $watch nodestroy}
 
89
    bind $watch <Delete> {Removearg_bp $lbvarname $lbvarval; \
 
90
                          closewatch_bp $watch nodestroy}
 
91
    bind $lbvarval <<ListboxSelect>> {selectinrightwin_bp $lbvarname $lbvarval}
 
92
    bind $lbvarname <ButtonPress-3> {set itemindex [dragitem_bp $lbvarname %y]}
 
93
    bind $lbvarname <ButtonRelease-3> {dropitem_bp $lbvarname $lbvarval "" $itemindex %y}
 
94
    bind $watch <Up> {scrollarrows_bp $lbvarname up}
 
95
    bind $watch <Down> {scrollarrows_bp $lbvarname down}
 
96
    bind $watch <MouseWheel> {if {%D<0} {scrollarrows_bp $lbvarname down}\
 
97
                                       {scrollarrows_bp $lbvarname up}}
 
98
    bind $watch <Enter> {set watchgeom [string trimleft [eval {wm geometry $watch}] 1234567890x]}
 
99
    if { $firsttimeinshowwatch == "true" } { 
 
100
        focus $buttonAdd
 
101
        set watchgeom [string trimleft [eval {wm geometry $watch}] 1234567890x]
 
102
        ScilabEval "getf \"$env(SCIPATH)/tcl/scipadsources/FormatStringsForDebugWatch.sci\""
 
103
        set firsttimeinshowwatch "false"
 
104
    }
 
105
}
 
106
 
 
107
proc closewatch_bp {w {dest "destroy"}} {
 
108
    global lbvarname lbvarval
 
109
    global watchvars watchvarsvals
 
110
    set watchvars ""
 
111
    array set watchvarsvals {}
 
112
    for {set i 0} {$i < [$lbvarname size]} {incr i} {
 
113
        set wvarname [$lbvarname get $i]
 
114
        set watchvars "$watchvars $wvarname"
 
115
        set wvarvalue [$lbvarval get $i]
 
116
        set watchvarsvals($wvarname) $wvarvalue
 
117
    }
 
118
    if {$dest == "destroy"} {destroy $w}
 
119
}
 
120
 
 
121
proc creategetfromshellcomm {} {
 
122
#    global watchvars watchvarsvals unklabel
 
123
#    while {[checkscilabbusy "nomessage"] == "busy"} {}
 
124
#    set fullcomm ""
 
125
#    foreach var $watchvars {
 
126
#         set comm1 "if exists(\"$var\"),"
 
127
##         set comm2 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"\"+string($var)+\"\"\"}\");"
 
128
#         set comm2 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"\"+FormatStringsForDebugWatch($var)+\"\"\"}\");"
 
129
#         set comm3 "else"
 
130
#         set comm4 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"$unklabel\"\"}\");"
 
131
#         set comm5 "end;"
 
132
#         set fullcomm [concat $fullcomm $comm1 $comm2 $comm3 $comm4 $comm5]
 
133
#    }
 
134
#    if {$fullcomm != ""} {
 
135
#         set fullcomm [concat $fullcomm "TK_EvalStr(\"scipad eval {showwatch_bp}\");" ]
 
136
#    }
 
137
#    return $fullcomm
 
138
    global watchvars watchvarsvals unklabel env tmpdir
 
139
    set fullcomm ""
 
140
#    set filename [file join "$env(SCIPATH)" "tcl" "scipadsources" "getwatchcomm.sce"]
 
141
    set filename [file join "$tmpdir" "getwatchcomm.sce"]
 
142
    set tempfile [open $filename w+]
 
143
    foreach var $watchvars {
 
144
         set comm1 "if exists(\"$var\"),"
 
145
#         set comm2 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"\"+string($var)+\"\"\"}\");"
 
146
         set comm2 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"\"+FormatStringsForDebugWatch($var)+\"\"\"}\");"
 
147
         set comm3 "else"
 
148
         set comm4 "TK_EvalStr(\"scipad eval {set watchvarsvals($var) \"\"$unklabel\"\"}\");"
 
149
         set comm5 "end;"
 
150
         set fullcomm [concat $comm1 $comm2 $comm3 $comm4 $comm5]
 
151
         puts $tempfile $fullcomm
 
152
    }
 
153
    if {$fullcomm != ""} {
 
154
         set fullcomm "TK_EvalStr(\"scipad eval {showwatch_bp}\");"
 
155
         puts $tempfile $fullcomm
 
156
    }
 
157
    close $tempfile
 
158
    return $filename
 
159
}
 
160
 
 
161
proc createsetinscishellcomm {} {
 
162
    global watchvars watchvarsvals unklabel
 
163
    set fullcomm ""
 
164
    set varset ""
 
165
    set retcomm ""
 
166
    foreach var $watchvars {
 
167
        if {$watchvarsvals($var) != $unklabel} {
 
168
            set onecomm [duplicatechars "$var=$watchvarsvals($var);" "\""]
 
169
            set onecomm [duplicatechars $onecomm "'"]
 
170
            set fullcomm [concat $fullcomm $onecomm]
 
171
            set varset [concat $varset $var]
 
172
        }
 
173
    }
 
174
    if {$fullcomm != ""} {
 
175
        set fullcomm "execstr(\"$fullcomm\",\"errcatch\",\"m\");"
 
176
        foreach var $varset {
 
177
            set retcomm "$retcomm,$var"
 
178
        }
 
179
        set retcomm [string range $retcomm 1 end]
 
180
        set retcomm "\[$retcomm\]=resume($retcomm)"
 
181
    }
 
182
    return [list $fullcomm $retcomm]
 
183
}
 
184
 
 
185
proc duplicatechars {st ch} {
 
186
# warning: $ch must be a single character string (but it works for the string "\"")
 
187
    set indquot [string first $ch $st 0]
 
188
    while {$indquot != -1} {
 
189
        set st [string replace $st $indquot $indquot "$ch$ch"]
 
190
        set indquot [string first $ch $st [expr $indquot + 2]]
 
191
    }
 
192
    return $st
 
193
}