1 |
# ProbeProc.tcl: Tcl code for Probe window |
2 |
# by Benjamin A. Allan and Kirk A. Abbott |
3 |
# Created: January 1994 |
4 |
# Part of ASCEND |
5 |
# Revision: $Revision: 1.34 $ |
6 |
# Last modified on: $Date: 1998/06/18 15:54:52 $ |
7 |
# Last modified by: $Author: mthomas $ |
8 |
# Revision control file: $RCSfile: ProbeProc.tcl,v $ |
9 |
# |
10 |
# This file is part of the ASCEND Tcl/Tk Interface. |
11 |
# |
12 |
# Copyright (C) 1994-1998 Carnegie Mellon University |
13 |
# |
14 |
# The ASCEND Tcl/Tk Interface is free software; you can redistribute |
15 |
# it and/or modify it under the terms of the GNU General Public |
16 |
# License as published by the Free Software Foundation; either |
17 |
# version 2 of the License, or (at your option) any later version. |
18 |
# |
19 |
# The ASCEND Tcl/Tk Interface is distributed in hope that it will be |
20 |
# useful, but WITHOUT ANY WARRANTY; without even the implied warranty |
21 |
# of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22 |
# GNU General Public License for more details. |
23 |
# |
24 |
# You should have received a copy of the GNU General Public License |
25 |
# along with the program; if not, write to the Free Software |
26 |
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the |
27 |
# file named COPYING. COPYING is found in ../compiler. |
28 |
|
29 |
# temporary debugging containers |
30 |
proc probe {args} { |
31 |
set str "probe " |
32 |
append str $args |
33 |
append str "\n The probe has been reimplemented completely." |
34 |
append str "\n" 'help __probe' for details" |
35 |
Script_Raise_Alert $str |
36 |
} |
37 |
|
38 |
# |
39 |
# proc set_Probe_Defaults {} |
40 |
#------------------------------------------------------------------------ |
41 |
# startup Probe after windows |
42 |
# |
43 |
# ascProbVect is also home to probe window state information. |
44 |
# in particular file menu data. |
45 |
# ascProbVect(collection) is the presently viewed buffer. -1 is the |
46 |
# bogus initialization value. |
47 |
# |
48 |
# ascProbVect(maxbufnum) is the highest available buffer num. |
49 |
#bugs buffile not used properly yet. |
50 |
# ascProbVect(buffile.$c) is the filename corresponding to buffer $c |
51 |
# ascProbVect(bufopen.$c) is the closed/open status of the buffer. |
52 |
# note we need some file menu reconstruction if close is to be used. |
53 |
#------------------------------------------------------------------------ |
54 |
proc set_Probe_Defaults {} { |
55 |
global ascProbVect ascProbImportVect ascParPageVect |
56 |
global ascGlobalVect |
57 |
|
58 |
#puts "setting Probe buttons" |
59 |
|
60 |
if {![info exists ascProbVect(font)]} { |
61 |
set ascProbVect(font) $ascGlobalVect(font) |
62 |
} |
63 |
set ascProbVect() [pwd] |
64 |
set ascProbVect(basefiletypes) { |
65 |
{{Names files} {.a4p} } |
66 |
{{Most} {.*} } |
67 |
{{All} {*} } |
68 |
} |
69 |
set ascProbVect(filetypes) $ascProbVect(basefiletypes) |
70 |
set ascProbVect(windowname) .probe |
71 |
set ascProbVect(collection) 0 |
72 |
set ascProbVect(initialized) FALSE |
73 |
# This is done in ProbeSwitchBuf |
74 |
# set ascProbVect(vbox) .probe.main_frm.probe_box_1.listbox1 |
75 |
# buffer management: |
76 |
set ascProbVect(listbasename) .probe.main_frm.probe_box_ |
77 |
set ascProbVect(bufferentry) .probe.buffer_frm.buffer_entry |
78 |
set ascProbVect(fileBtn) .probe.menubar.file |
79 |
set ascProbVect(editBtn) .probe.menubar.edit |
80 |
set ascProbVect(expoBtn) .probe.menubar.export |
81 |
|
82 |
set ascProbImportVect(namelist) [list rootname Buffer] |
83 |
set filterlist [__probe filters] |
84 |
foreach i $filterlist { |
85 |
set parts [split $i /] |
86 |
set sub [lindex $parts 0] |
87 |
lappend ascProbImportVect(namelist) $sub |
88 |
lappend ascProbImportVect(filterlist) $sub |
89 |
set ascProbImportVect($sub) 0 |
90 |
set ascProbImportVect($sub.type) bool |
91 |
set ascProbImportVect($sub.label) [lindex $parts 1] |
92 |
} |
93 |
# it's ugly, but we need a default. |
94 |
set ascProbImportVect(VisitReals) 1 |
95 |
set ascProbImportVect(rootname) "" |
96 |
set ascProbImportVect(rootname.label) "Exporting from" |
97 |
set ascProbImportVect(rootname.type) string |
98 |
set ascProbImportVect(Buffer) current |
99 |
set ascProbImportVect(Buffer.label) "Probe buffer:" |
100 |
set ascProbImportVect(Buffer.type) string |
101 |
|
102 |
set ascProbImportVect(grab) 1 |
103 |
set ascProbImportVect(npages) 1 |
104 |
set ascProbImportVect(toplevel) .probimport |
105 |
set ascProbImportVect(title) "Probe export filters" |
106 |
set ascProbImportVect(helpcommand) {Help_button browser.export.many} |
107 |
set ascProbImportVect(whenokcommand) "" |
108 |
|
109 |
set ascParPageVect(btn_font) $ascProbVect(font) |
110 |
set ascParPageVect(lbl_font) $ascProbVect(font) |
111 |
|
112 |
set ascProbVect(mainframe) .probe.main_frm |
113 |
set ascProbVect(collection) -1 |
114 |
set ascProbVect(maxbufnum) -1 |
115 |
|
116 |
Configure_Probe |
117 |
} |
118 |
|
119 |
|
120 |
# proc Configure_Probe {} |
121 |
#------------------------------------------------------------------------ |
122 |
# misc bindings |
123 |
#------------------------------------------------------------------------ |
124 |
proc Configure_Probe {} { |
125 |
global ascProbVect; |
126 |
|
127 |
Probe_do_NewBuffer |
128 |
ascclearlist $ascProbVect(vbox); |
129 |
|
130 |
# Update Enabled/Disabled entries when a menu is posted |
131 |
# |
132 |
$ascProbVect(editBtn) configure \ |
133 |
-postcommand Probe_Update_EditButtons |
134 |
|
135 |
$ascProbVect(expoBtn) configure \ |
136 |
-postcommand Probe_Update_ExpButtons |
137 |
|
138 |
$ascProbVect(fileBtn) configure \ |
139 |
-postcommand Probe_Update_FileButtons |
140 |
|
141 |
.probe.menubar.view configure \ |
142 |
-postcommand Probe_Update_View_Buttons |
143 |
|
144 |
# set pointer |
145 |
.probe configure -cursor left_ptr |
146 |
} |
147 |
|
148 |
# |
149 |
# proc Probe_do_Font {} |
150 |
#--------------------------------------------------------------------- |
151 |
# font select button for Probe window. updates all listboxes. |
152 |
#--------------------------------------------------------------------- |
153 |
proc Probe_do_Font {args} { |
154 |
global ascProbVect |
155 |
set font "" |
156 |
if {$args != ""} { |
157 |
set font $args |
158 |
} else { |
159 |
set font [ascFontGet] |
160 |
} |
161 |
if {"$font" == ""} { |
162 |
return; |
163 |
} |
164 |
set len $ascProbVect(maxbufnum) |
165 |
set ascProbVect(font) $font |
166 |
for {set c 0} { $c <= $len} { incr c} { |
167 |
$ascProbVect(listbasename)$c.listbox1 configure -font $font |
168 |
} |
169 |
$ascProbVect(bufferentry) configure -font $font |
170 |
} |
171 |
|
172 |
# |
173 |
# proc Probe_Update_EditButtons {} |
174 |
#------------------------------------------------------------------------ |
175 |
# dis/enable edit buttons |
176 |
#------------------------------------------------------------------------ |
177 |
proc Probe_Update_EditButtons {} { |
178 |
global ascProbVect |
179 |
set m $ascProbVect(editBtn) |
180 |
|
181 |
if {[$ascProbVect(vbox) size] == 0} { |
182 |
$m entryconfigure 1 -state disabled |
183 |
$m entryconfigure 2 -state disabled |
184 |
} else { |
185 |
$m entryconfigure 1 -state normal |
186 |
$m entryconfigure 2 -state normal |
187 |
} |
188 |
} |
189 |
|
190 |
|
191 |
# |
192 |
# proc Probe_Update_FileButtons {} |
193 |
#------------------------------------------------------------------------ |
194 |
# dis/enable File buttons |
195 |
#------------------------------------------------------------------------ |
196 |
proc Probe_Update_FileButtons {} { |
197 |
global ascProbVect |
198 |
set m $ascProbVect(fileBtn) |
199 |
|
200 |
# New buffer is always available |
201 |
$m entryconfigure 0 -state normal |
202 |
|
203 |
# Read |
204 |
$m entryconfigure 1 -state normal |
205 |
|
206 |
# Print |
207 |
if {[$ascProbVect(vbox) size] == 0} { |
208 |
$m entryconfigure 2 -state disabled |
209 |
$m entryconfigure 3 -state disabled |
210 |
$m entryconfigure 4 -state disabled |
211 |
} { |
212 |
$m entryconfigure 2 -state normal |
213 |
$m entryconfigure 3 -state normal |
214 |
$m entryconfigure 4 -state normal |
215 |
} |
216 |
} |
217 |
|
218 |
# |
219 |
# proc Probe_Update_View_Buttons {} |
220 |
#------------------------------------------------------------------------ |
221 |
# dis/enable View buttons |
222 |
#------------------------------------------------------------------------ |
223 |
proc Probe_Update_View_Buttons {} { |
224 |
global ascProbVect ascGlobalVect |
225 |
|
226 |
set mb .probe.menubar.view |
227 |
|
228 |
if {$ascGlobalVect(saveoptions) == 0} { |
229 |
$mb entryconfigure 2 -state disabled |
230 |
} else { |
231 |
$mb entryconfigure 2 -state normal |
232 |
} |
233 |
|
234 |
} |
235 |
|
236 |
# |
237 |
# proc Probe_Update_ExpButtons {} |
238 |
#------------------------------------------------------------------------ |
239 |
# dis/enable expo buttons. |
240 |
# The export to Display menu item can be used as a sort of reporting |
241 |
# feature, where results from the probe can be embedded into the display. |
242 |
#------------------------------------------------------------------------ |
243 |
proc Probe_Update_ExpButtons {} { |
244 |
global ascProbVect |
245 |
set m $ascProbVect(expoBtn) |
246 |
|
247 |
if {[$ascProbVect(vbox) size] == 0} { |
248 |
$m entryconfigure 0 -state disabled |
249 |
$m entryconfigure 1 -state disabled |
250 |
} { |
251 |
$m entryconfigure 0 -state normal |
252 |
$m entryconfigure 1 -state normal |
253 |
} |
254 |
} |
255 |
|
256 |
|
257 |
# |
258 |
# proc Probe_Import {collection name args} |
259 |
#------------------------------------------------------------------------ |
260 |
# Send named item to probe. collection may be |
261 |
# 'new', 'current' or the number of an existing collection. |
262 |
# Collections number consecutively from 0 as they are created. |
263 |
# If args is not empty, it must be a well-formed filter-list for |
264 |
# __probe add |
265 |
# This function should be the only hub-notifying and window updating |
266 |
# functions. All other import functions should be wrappers to this. |
267 |
#------------------------------------------------------------------------ |
268 |
proc Probe_Import {collection name args} { |
269 |
global ascProbVect |
270 |
# puts "Probe_Import $collection $name $args" |
271 |
set logcollection $collection |
272 |
if {$collection == "" || $name ==""} { |
273 |
return |
274 |
} |
275 |
if {$collection == "current"} { |
276 |
set collection $ascProbVect(collection) |
277 |
} |
278 |
if {$collection == "new"} { |
279 |
set collection [Probe_do_NewBuffer] |
280 |
} |
281 |
if {$collection <0 || $collection > $ascProbVect(collection)} { |
282 |
Script_Raise_Alert \ |
283 |
"Probe_Import called with bad collection number $collection." |
284 |
} |
285 |
set commandstring "__probe add $collection " |
286 |
append commandstring \{ $name \} |
287 |
foreach i [stripbraces $args] { |
288 |
append commandstring " $i" |
289 |
} |
290 |
eval $commandstring |
291 |
Probe_Update $collection |
292 |
if {$ascProbVect(visibility)} { |
293 |
newraise $ascProbVect(windowname); |
294 |
} |
295 |
HUB_Message_to_HUB INSTPROBED $logcollection $name $args |
296 |
} |
297 |
|
298 |
# |
299 |
# Probe_Import_List |
300 |
#------------------------------------------------------------------------ |
301 |
# imports a list of complete names |
302 |
#------------------------------------------------------------------------ |
303 |
proc Probe_Import_List {number list} { |
304 |
foreach i $list { |
305 |
Probe_Import $number $i |
306 |
} |
307 |
} |
308 |
|
309 |
# |
310 |
# proc Probe_Import_Filtered {caller name {automatic 0}} |
311 |
#------------------------------------------------------------------------ |
312 |
# caller is the name of the toplevel window calling this function. |
313 |
# Send instances in named subtree to probe. |
314 |
# if automatic, then no dialog is used to get filter options. |
315 |
# collections are C structures. |
316 |
#------------------------------------------------------------------------ |
317 |
proc Probe_Import_Filtered {caller name {automatic 0}} { |
318 |
global ascProbVect |
319 |
global ascProbImportVect |
320 |
|
321 |
set ascProbImportVect(rootname) $name |
322 |
set ascProbImportVect(rootname.choices) $ascProbImportVect(rootname) |
323 |
set ascProbImportVect(Buffer.choices) "current new" |
324 |
set len $ascProbVect(maxbufnum) |
325 |
for {set c 0} {$c <= $len} {incr c} { |
326 |
append ascProbImportVect(Buffer.choices) " $c" |
327 |
} |
328 |
set ascProbImportVect(title) "Filtering " |
329 |
append ascProbImportVect(title) $ascProbImportVect(rootname) |
330 |
if {$automatic == 0} { |
331 |
set ascParPageVect(btn_font) $ascProbVect(font) |
332 |
set ascParPageVect(lbl_font) $ascProbVect(font) |
333 |
ascParPage ascProbImportVect [setpos $caller 0 0] 1 |
334 |
if {$ascProbImportVect(__,cancelled)} { |
335 |
return |
336 |
} |
337 |
} |
338 |
set filter "" |
339 |
foreach i $ascProbImportVect(filterlist) { |
340 |
lappend filter $ascProbImportVect($i) |
341 |
} |
342 |
Probe_Import $ascProbImportVect(Buffer) $name $filter |
343 |
set ascProbImportVect(Buffer) current |
344 |
} |
345 |
|
346 |
|
347 |
# |
348 |
#--------------------------------------------------------------------------- |
349 |
#buffer management stuff |
350 |
#--------------------------------------------------------------------------- |
351 |
|
352 |
# |
353 |
# proc ProbeSwitchToNewBuf {{fname ""}} |
354 |
#--------------------------------------------------------------------------- |
355 |
# ascProbVect(buffile.$num) the filename of numbered buffer |
356 |
# ascProbVect(mainframe) the name of the parent for all probe_box widgets |
357 |
# ascProbVect(collection) the number of the buffer in use currently |
358 |
# |
359 |
# switches to the numbered buffer. if the buffer isn't open, |
360 |
# creates it. If fname is given != "" on a closed buffer, |
361 |
# will read the buffer from disk, eventually... |
362 |
# as we can see, this function needs to be decomposed. |
363 |
#--------------------------------------------------------------------------- |
364 |
proc ProbeSwitchToNewBuf {{fname ""}} { |
365 |
global ascProbVect ascGlobalVect |
366 |
|
367 |
set num [__probe expand] |
368 |
set ascProbVect(maxbufnum) $num |
369 |
set filename "foobar" |
370 |
set parentname $ascProbVect(mainframe) |
371 |
if {$fname == ""} { |
372 |
set filename NoName$num.a4p |
373 |
set ascProbVect(buffile.$num) $filename |
374 |
set ascProbVect(bufopen.$num) 0 |
375 |
} else { |
376 |
set filename $fname |
377 |
} |
378 |
set oldnum $ascProbVect(collection) |
379 |
set oldbufname .probe_box_$oldnum |
380 |
catch {pack forget $parentname$oldbufname} |
381 |
set ascProbVect(collection) $num |
382 |
set ascProbVect(filename) $filename |
383 |
set ascProbVect(vbox) $parentname.probe_box_$num.listbox1 |
384 |
|
385 |
set winlist [build_probebox $parentname $num $ascProbVect(font)] |
386 |
Probe_bindListbox $winlist.listbox1 |
387 |
|
388 |
# pack widget $parentname |
389 |
pack append $parentname \ |
390 |
$parentname.probe_box_$num {top frame center expand fill} |
391 |
|
392 |
$ascProbVect(fileBtn) add command \ |
393 |
-command "ProbeSwitchToOldBuf $num $filename" \ |
394 |
-label $filename |
395 |
set ascProbVect(bufopen.$num) 1 |
396 |
$parentname.probe_box_$num.listbox1 insert end {} |
397 |
|
398 |
set ascProbVect(maxbufnum) $num |
399 |
update |
400 |
update idletasks |
401 |
} |
402 |
|
403 |
|
404 |
proc ProbeSwitchToOldBuf {num fname} { |
405 |
global ascProbVect |
406 |
|
407 |
set parentname $ascProbVect(mainframe) |
408 |
set oldnum $ascProbVect(collection) |
409 |
set oldbufname .probe_box_$oldnum |
410 |
catch {pack forget $parentname$oldbufname} |
411 |
set ascProbVect(collection) $num |
412 |
set ascProbVect(filename) $fname |
413 |
set ascProbVect(vbox) $parentname.probe_box_$num.listbox1 |
414 |
pack append $parentname \ |
415 |
$parentname.probe_box_$num {top frame center expand fill} |
416 |
Probe_Update $num |
417 |
update |
418 |
update idletasks |
419 |
} |
420 |
|
421 |
|
422 |
# proc Probe_do_NewBuffer |
423 |
#------------------------------------------------------------------------ |
424 |
# open a new buffer named NoNameN.a4p |
425 |
# where N is the current max buffer number |
426 |
#------------------------------------------------------------------------ |
427 |
proc Probe_do_NewBuffer {} { |
428 |
global ascProbVect |
429 |
set num [__probe size] |
430 |
ProbeSwitchToNewBuf |
431 |
return $num |
432 |
} |
433 |
|
434 |
# |
435 |
# proc Probe_load_file {file bufnumber} |
436 |
#------------------------------------------------------------------------ |
437 |
# collection names read from file to collection number given |
438 |
# collection must already exist. returns the number of errors. |
439 |
#------------------------------------------------------------------------ |
440 |
proc Probe_load_file {filename bufnum} { |
441 |
global ascProbVect |
442 |
if {$ascProbVect(maxbufnum) < $bufnum} { |
443 |
Script_Raise_Alert "Cannot read into nonexistent probe buffer $bufnum" |
444 |
return 1 |
445 |
} |
446 |
set fname [file nativename $filename] |
447 |
if {[file isfile $fname] && [file readable $fname]} { } else { |
448 |
set err "Cannot read probe names file " |
449 |
append err $fname |
450 |
Script_Raise_Alert $err |
451 |
return 1 |
452 |
} |
453 |
set ec 0 |
454 |
if {[catch { |
455 |
set cid [open $fname r] |
456 |
set input [read -nonewline $cid] |
457 |
close $cid |
458 |
foreach i $input { |
459 |
if {$i != "" && [string index $i 0] != "#"} { |
460 |
if {[catch {__probe add $bufnum $i} err]} { |
461 |
incr ec |
462 |
} |
463 |
} |
464 |
} |
465 |
} msg]} { |
466 |
Script_Raise_Alert "Error reading values file" |
467 |
return 1; |
468 |
} |
469 |
catch {__probe update $bufnum} |
470 |
set ascProbVect(filename) $fname |
471 |
return $ec |
472 |
} |
473 |
|
474 |
# |
475 |
# proc Probe_do_Read {} |
476 |
#------------------------------------------------------------------------ |
477 |
# move names from file to current collection |
478 |
#------------------------------------------------------------------------ |
479 |
proc Probe_do_ReadFile {} { |
480 |
global ascProbVect asc_tkfbox ascGlobalVect |
481 |
set defaultname [file dirname $ascProbVect(filename)] |
482 |
set asc_tkfbox(otherdirs) $ascGlobalVect(librarypathdirs) |
483 |
set filename [tk_getOpenFile \ |
484 |
-defaultextension "" \ |
485 |
-filetypes $ascProbVect(filetypes) \ |
486 |
-initialdir $defaultname \ |
487 |
-parent $ascProbVect(windowname)\ |
488 |
-title {Read saved names file}] |
489 |
|
490 |
if {$filename == "" && $asc_tkfbox(cancelled)==0} { |
491 |
set err "Cannot read \"\"" |
492 |
Script_Raise_Alert $err |
493 |
return |
494 |
} |
495 |
if {$asc_tkfbox(cancelled)} { |
496 |
return |
497 |
} |
498 |
if {[file isdirectory $filename]} { |
499 |
set err "Cannot read names from directory " |
500 |
append err $filename |
501 |
Script_Raise_Alert $err |
502 |
return |
503 |
} |
504 |
Probe_load_file $filename $ascProbVect(collection) |
505 |
Probe_Update $ascProbVect(collection) |
506 |
} |
507 |
|
508 |
# |
509 |
# proc Probe_write {col file} |
510 |
#------------------------------------------------------------------------ |
511 |
# dump specified collection names to file named. |
512 |
#------------------------------------------------------------------------ |
513 |
proc Probe_write {col file} { |
514 |
set cid [open $file w+] |
515 |
puts -nonewline $cid "#$col\{" |
516 |
puts -nonewline $cid $file |
517 |
puts $cid "\}" |
518 |
set max [__probe size $col] |
519 |
for {set i 0} {$i < $max} {incr i} { |
520 |
puts -nonewline "$col $i " |
521 |
puts [__probe name $col $i] |
522 |
puts -nonewline $cid "\{" |
523 |
puts -nonewline $cid [__probe name $col $i] |
524 |
puts $cid "\}" |
525 |
} |
526 |
close $cid |
527 |
puts -nonewline stdout "Wrote " |
528 |
puts stdout $file |
529 |
} |
530 |
|
531 |
# |
532 |
# proc Probe_do_WriteBuf {} |
533 |
#------------------------------------------------------------------------ |
534 |
# dump current collection names to associated file. |
535 |
#------------------------------------------------------------------------ |
536 |
proc Probe_do_WriteBuf {} { |
537 |
global ascProbVect |
538 |
set col $ascProbVect(collection) |
539 |
if {[__probe size $col]} { |
540 |
if {[file exists $ascProbVect(buffile.$col)]} { |
541 |
if {[file writable $ascProbVect(buffile.$col)]} { |
542 |
# fsbox takes care of overwrite query |
543 |
Probe_write $col $ascProbVect(buffile.$col) |
544 |
} else { |
545 |
set mess "File " |
546 |
append mess $ascProbVect(buffile.$col) |
547 |
append mess " is not writable" |
548 |
Script_Raise_Alert $mess FYI |
549 |
} |
550 |
} else { |
551 |
Probe_write $col $ascProbVect(buffile.$col) |
552 |
} |
553 |
} else { |
554 |
Script_Raise_Alert "Empty probe $col cannot be saved" "FYI" |
555 |
} |
556 |
} |
557 |
|
558 |
# |
559 |
# proc Probe_do_WriteBufAs {} |
560 |
#------------------------------------------------------------------------ |
561 |
# dump current collection names to user specified file |
562 |
#------------------------------------------------------------------------ |
563 |
proc Probe_do_WriteBufAs {} { |
564 |
global ascProbVect asc_tkfbox |
565 |
set col $ascProbVect(collection) |
566 |
if {[__probe size $col]} { |
567 |
set defaultname $ascProbVect(filename) |
568 |
set filename [tk_getSaveFile \ |
569 |
-defaultextension "" \ |
570 |
-filetypes $ascProbVect(filetypes) \ |
571 |
-initialfile $defaultname \ |
572 |
-parent .probe \ |
573 |
-title {Save probe names AS}] |
574 |
if {$filename == "" && !$asc_tkfbox(cancelled)} { |
575 |
Script_Raise_Alert "No file name given. Not saved" "FYI" |
576 |
} |
577 |
set fname [file nativename $filename] |
578 |
if {[file exists $fname]} { |
579 |
if {[file writable $fname]} { |
580 |
# fsbox takes care of overwrite query |
581 |
Probe_write $col $fname |
582 |
} else { |
583 |
set mess "File " |
584 |
append mess $fname |
585 |
append mess " is not writable" |
586 |
Script_Raise_Alert $mess FYI |
587 |
} |
588 |
} else { |
589 |
Probe_write $col $fname |
590 |
} |
591 |
} else { |
592 |
Script_Raise_Alert "Empty probe $col cannot be saved" "FYI" |
593 |
} |
594 |
} |
595 |
|
596 |
# |
597 |
# proc Probe_do_Print {} |
598 |
#------------------------------------------------------------------------ |
599 |
# dump collection view to file |
600 |
#------------------------------------------------------------------------ |
601 |
proc Probe_do_Print {} { |
602 |
global ascProbVect |
603 |
$ascProbVect(vbox) selection clear 0 end |
604 |
Print_configure ascProbVect(windowname) |
605 |
if {[Print_cancelcheck]} { |
606 |
return |
607 |
} |
608 |
DispPrint [DispWriteSelection $ascProbVect(vbox)] |
609 |
HUB_Message_to_HUB WINDOWPRINTED PROBE |
610 |
} |
611 |
|
612 |
# |
613 |
# proc Probe_Get_Selection {collection} |
614 |
#------------------------------------------------------------------------ |
615 |
# returns current probe selection |
616 |
#------------------------------------------------------------------------ |
617 |
proc Probe_Get_Selection {collection} { |
618 |
global ascProbVect; |
619 |
set sel_list [$ascProbVect(vbox) curselection] |
620 |
return $sel_list; |
621 |
} |
622 |
|
623 |
# |
624 |
# proc Probe_Update {collection} |
625 |
#------------------------------------------------------------------------ |
626 |
# stuff probe window of the collection given |
627 |
#------------------------------------------------------------------------ |
628 |
proc Probe_Update {collection} { |
629 |
global ascProbVect |
630 |
ascclearlist $ascProbVect(vbox) |
631 |
foreach item [__probe get $collection] { |
632 |
$ascProbVect(vbox) insert end $item |
633 |
} |
634 |
} |
635 |
|
636 |
# proc Probe_Remove_Pattern |
637 |
#------------------------------------------------------------------------ |
638 |
# This function will take a pattern and remove all things that |
639 |
# match the pattern from the probe. This might be used to |
640 |
# say remove : everything that matches T*, or lower_bound etc. |
641 |
# It accepts a list of indices, eliminates what does not match |
642 |
# and returns the modified list to be used by Probe_Delete. |
643 |
# Assumes that we DONT have disjoint listbox selections. |
644 |
# Remember that we always count from 1 up on the C-side of |
645 |
# things. |
646 |
#------------------------------------------------------------------------ |
647 |
proc Probe_Remove_Pattern {list pattern} { |
648 |
Script_Raise_Alert "Probe_Remove_Pattern not implemented" |
649 |
} |
650 |
|
651 |
# |
652 |
# proc Probe_do_SelectAll |
653 |
#------------------------------------------------------------------------ |
654 |
# function to select all in probe |
655 |
#------------------------------------------------------------------------ |
656 |
proc Probe_do_SelectAll {} { |
657 |
global ascProbVect |
658 |
$ascProbVect(vbox) select set 0 end |
659 |
} |
660 |
|
661 |
|
662 |
# |
663 |
# proc Probe_do_RemoveSelections |
664 |
#------------------------------------------------------------------------ |
665 |
# removes the selected item in the current collection. |
666 |
# selection may be disjoint. |
667 |
#------------------------------------------------------------------------ |
668 |
proc Probe_do_RemoveSelections {} {# The command bound to the MenuButton |
669 |
|
670 |
global ascProbVect |
671 |
set collection $ascProbVect(collection) |
672 |
set delete_list "[Probe_Get_Selection $collection]" |
673 |
if {$delete_list != ""} { |
674 |
set pccommand "__probe clear $collection $delete_list" |
675 |
eval $pccommand |
676 |
Probe_Update $collection |
677 |
} |
678 |
} |
679 |
|
680 |
# |
681 |
# proc Probe_do_RemoveAll |
682 |
#------------------------------------------------------------------------ |
683 |
# delete all probe stuff in current buffer. |
684 |
#------------------------------------------------------------------------ |
685 |
proc Probe_do_RemoveAll {} { |
686 |
global ascProbVect |
687 |
set collection $ascProbVect(collection) |
688 |
__probe clear $collection |
689 |
Probe_Update $collection |
690 |
} |
691 |
|
692 |
# |
693 |
# proc Probe_do_RemoveUncertain |
694 |
#------------------------------------------------------------------------ |
695 |
# delete all uncertain stuff in current buffer. |
696 |
#------------------------------------------------------------------------ |
697 |
proc Probe_do_RemoveUncertain {} { |
698 |
global ascProbVect |
699 |
set collection $ascProbVect(collection) |
700 |
__probe trash |
701 |
Probe_Update $collection |
702 |
} |
703 |
|
704 |
# |
705 |
# proc Probe_do_Copy |
706 |
#------------------------------------------------------------------------ |
707 |
# Copy current probe to clipboard |
708 |
#------------------------------------------------------------------------ |
709 |
proc Probe_do_Copy {} { |
710 |
global ascProbVect |
711 |
asc_export_selection $ascProbVect(vbox) |
712 |
event generate $ascProbVect(vbox) <<Copy>> |
713 |
} |
714 |
|
715 |
|
716 |
# |
717 |
# proc Probe_HandleInstanceMoved |
718 |
#------------------------------------------------------------------------ |
719 |
# This procedure will be registered with the HUB. |
720 |
# Whenever an instance is ABOUT to moved in memory, such as with a merge, |
721 |
# refine or are_alike, This procedure will be invoked first so that |
722 |
# ALL instances become uncertain in all probes. |
723 |
#------------------------------------------------------------------------ |
724 |
proc Probe_HandleInstanceMoved {args} { |
725 |
global ascProbVect |
726 |
__probe invalidate |
727 |
Probe_Update $ascProbVect(collection) |
728 |
} |
729 |
|
730 |
# |
731 |
# proc Probe_HandleNewInstances |
732 |
#------------------------------------------------------------------------ |
733 |
# This procedure will be registered with the HUB. |
734 |
# Whenever new instances are in memory, such as after a merge, |
735 |
# refine or are_alike, This procedure will be invoked first so that |
736 |
# uncertain instances become defined again. |
737 |
#------------------------------------------------------------------------ |
738 |
proc Probe_HandleNewInstances {args} { |
739 |
global ascProbVect |
740 |
__probe update |
741 |
Probe_Update $ascProbVect(collection) |
742 |
} |
743 |
|
744 |
# |
745 |
# proc Probe_HandleSimsDelete |
746 |
#------------------------------------------------------------------------ |
747 |
# This procedure will be registered with the HUB. |
748 |
# It removes all references i.e in all collections, for a simulation that is |
749 |
# ABOUT to be deleted. |
750 |
#------------------------------------------------------------------------ |
751 |
proc Probe_HandleSimsDelete {{list ""}} { |
752 |
Probe_HandleInstanceMoved $list |
753 |
} |
754 |
|
755 |
# |
756 |
# proc Probe_HandleVariableUpdated |
757 |
#------------------------------------------------------------------------ |
758 |
# This procedure will be registered with the HUB. |
759 |
# Whenever a variables value has changed because of: |
760 |
# 1) solving completed. |
761 |
# 2) a procedure has been run. |
762 |
# 3) a variable has been assigned etc... |
763 |
# this procedure will be invoked to update only the currently focused |
764 |
# probe. The act of selecting a new probe collection via the radio buttons |
765 |
# will update that collection at the given time. |
766 |
#------------------------------------------------------------------------ |
767 |
proc Probe_HandleVariableUpdated {{list ""}} { |
768 |
global ascProbVect |
769 |
Probe_Update $ascProbVect(collection) |
770 |
} |
771 |
|
772 |
# |
773 |
# proc Probe_do_Export2Browser {} |
774 |
#------------------------------------------------------------------------ |
775 |
# export first of current selection in probe to browser. |
776 |
# The browser is expected to defend itself against UNCERTAIN names. |
777 |
#------------------------------------------------------------------------ |
778 |
proc Probe_do_Export2Browser {} { |
779 |
global ascProbVect |
780 |
set collection $ascProbVect(collection) |
781 |
set ndx_list [Probe_Get_Selection $collection] |
782 |
set ndx [lindex $ndx_list 0] |
783 |
if {$ndx == ""} { |
784 |
return; |
785 |
} |
786 |
set name [__probe name $collection $ndx] |
787 |
if {$name == ""} {return} |
788 |
Brow_Export_Any_2Browser $name |
789 |
} |
790 |
|
791 |
# |
792 |
# proc Probe_do_Export2Display {} |
793 |
#------------------------------------------------------------------------ |
794 |
# button. wrapper of export to display |
795 |
# Will take each item in the probe, which is a valid tcl list, |
796 |
# split of any braces and insert them one a time in the display |
797 |
# window at the current insertion cursor. The information that will |
798 |
# be exported will be the displayed information in the probe, and not |
799 |
# pulled up from the internal C data_structure. |
800 |
#------------------------------------------------------------------------ |
801 |
proc Probe_do_Export2Display {} {# bound to the menu_button |
802 |
global ascProbVect ascDispVect |
803 |
|
804 |
if {[winfo exists $ascDispVect(textBox)] == "0"} {return} |
805 |
set collection $ascProbVect(collection) |
806 |
set index_list [Probe_Get_Selection $collection] |
807 |
foreach index $index_list { |
808 |
set data [$ascProbVect(vbox) get $index] |
809 |
$ascDispVect(textBox) insert insert $data |
810 |
$ascDispVect(textBox) insert insert "\n" |
811 |
} |
812 |
newraise .display |
813 |
} |
814 |
|
815 |
# |
816 |
# proc Probe_do_Help {} |
817 |
# proc Probe_do_BindHelp {} |
818 |
#------------------------------------------------------------------------ |
819 |
# probe help buttons |
820 |
#------------------------------------------------------------------------ |
821 |
proc Probe_do_Help {} { |
822 |
Help_button probe |
823 |
} |
824 |
proc Probe_do_BindHelp {} { |
825 |
Help_button probe.help onprobe |
826 |
} |
827 |
# |
828 |
# proc Probe_Redraw {} |
829 |
#------------------------------------------------------------------------ |
830 |
# Redraw probe after interface restart |
831 |
#------------------------------------------------------------------------ |
832 |
proc Probe_Redraw {} { |
833 |
# data seems to linger across restarts, so no redraw |
834 |
} |
835 |
|
836 |
# |
837 |
# proc Probe_bindListbox {probelistbox} |
838 |
#------------------------------------------------------------------------ |
839 |
# bind probe after creation |
840 |
#------------------------------------------------------------------------ |
841 |
proc Probe_bindListbox {w} { |
842 |
bind $w <Button-3> { |
843 |
set d [%W nearest %y] |
844 |
if {$d != ""} { |
845 |
Probe_do_SetValue $d |
846 |
} |
847 |
} |
848 |
bind $w <Double-1> { |
849 |
set d [%W nearest %y] |
850 |
if {$d != ""} { |
851 |
Probe_do_BrowseItem $d |
852 |
} |
853 |
} |
854 |
} |
855 |
|
856 |
# |
857 |
# proc Probe_do_SetValue {ndx} |
858 |
#---------------------------------------------------------------------- |
859 |
# pull up an assignment dialog. this hsould maybe pull up a parameter |
860 |
# style page for assigning value and all assignable children. |
861 |
#---------------------------------------------------------------------- |
862 |
proc Probe_do_SetValue {ndx} { |
863 |
global ascProbVect |
864 |
set name [lindex [$ascProbVect(vbox) get $ndx] 0] |
865 |
if {[catch {qlfdid $name} errmsg]} {return} |
866 |
Browser_do_SetValue $ascProbVect(vbox) $name |
867 |
} |
868 |
|
869 |
# |
870 |
# proc Probe_do_BrowseItem {ndx} |
871 |
#---------------------------------------------------------------------- |
872 |
# browse the selected item at line ndx in the current probe. |
873 |
#---------------------------------------------------------------------- |
874 |
proc Probe_do_BrowseItem {ndx} { |
875 |
global ascProbVect |
876 |
set name [lindex [$ascProbVect(vbox) get $ndx] 0] |
877 |
if {[catch {qlfdid $name} errmsg]} {return} |
878 |
BROWSE $name |
879 |
} |
880 |
|
881 |
#------------------------------------------------------------------------ |
882 |
#------------------------------------------------------------------------ |
883 |
# |
884 |
# User Data functions. They will be kept here until we can find a |
885 |
# place for them to reside. These are most closely related to the |
886 |
# probe, but only by a vague similarity. |
887 |
# |
888 |
#------------------------------------------------------------------------ |
889 |
#------------------------------------------------------------------------ |
890 |
|
891 |
# |
892 |
# proc WRITE_VIRTUAL |
893 |
#------------------------------------------------------------------------ |
894 |
# Saves the information from the specified qualified id into a virtual |
895 |
# file with the given name. At the moment now only saves the information |
896 |
# associated with reals. |
897 |
#------------------------------------------------------------------------ |
898 |
proc WRITE_VIRTUAL {from to} { |
899 |
# first set up the search instance to look at the "from" instance. |
900 |
# |
901 |
set nok [catch "qlfdid \{$from\}" data_or_error] |
902 |
if {$nok} { |
903 |
Script_Raise_Alert "$data_or_error" "Probe Error" |
904 |
return 1; |
905 |
} |
906 |
# attempt to save the data. |
907 |
# |
908 |
set nok [catch "__userdata_save search $to" data_or_error] |
909 |
if {$nok} { |
910 |
Script_Raise_Alert "$data_or_error" "Probe Error" |
911 |
return 1; |
912 |
} |
913 |
return 0; |
914 |
} |
915 |
|
916 |
# |
917 |
# proc READ_VIRTUAL |
918 |
#------------------------------------------------------------------------ |
919 |
# Will restore the values from the virtual file back to the instance |
920 |
# tree. See the notes concerning writing of this virtual file. |
921 |
#------------------------------------------------------------------------ |
922 |
proc READ_VIRTUAL {id} { |
923 |
set nok [catch "__userdata_restore $id" data_or_error] |
924 |
if {$nok} { |
925 |
Script_Raise_Alert "$data_or_error" "Probe Error" |
926 |
return 1; |
927 |
} |
928 |
HUB_Message_to_HUB VARIABLEUPDATED |
929 |
return 0; |
930 |
} |
931 |
|
932 |
# |
933 |
# proc Probe_UserData_HandleSimsDelete |
934 |
#------------------------------------------------------------------------ |
935 |
# This function will be registered with the hub. It needs to be invoked |
936 |
# under the same conditions that will require a flush of the probe. |
937 |
#------------------------------------------------------------------------ |
938 |
proc Probe_UserData_HandleSimsDelete {args} { |
939 |
__userdata_destroy all |
940 |
__userdata_init |
941 |
return 0 |
942 |
} |
943 |
|
944 |
# |
945 |
# proc Probe_UserData_HandleInstanceMoved |
946 |
#------------------------------------------------------------------------ |
947 |
# This function will be registered with the hub. It needs to be invoked |
948 |
# under the same conditions that will require a flush of the probe. |
949 |
#------------------------------------------------------------------------ |
950 |
proc Probe_UserData_HandleInstanceMoved {args} { |
951 |
Probe_UserData_HandleSimsDelete $args |
952 |
return 0 |
953 |
} |