/[ascend]/trunk/tcltk/TK/ProbeProc.tcl
ViewVC logotype

Contents of /trunk/tcltk/TK/ProbeProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 659 - (show annotations) (download) (as text)
Sun Jun 4 20:01:04 2006 UTC (16 years, 7 months ago) by ben.allan
File MIME type: text/x-tcl
File size: 31415 byte(s)
added File->Open everywhere equivalent to File->Read ...  to resolve pye request.
At a 1.0 release of tcltk, we should consider getting rid of
the file reads, but not before. existing users have muscle memories
that are not to be toyed with.
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/open
204 $m entryconfigure 1 -state normal
205 $m entryconfigure 2 -state normal
206
207 # Print
208 if {[$ascProbVect(vbox) size] == 0} {
209 $m entryconfigure 3 -state disabled
210 $m entryconfigure 4 -state disabled
211 $m entryconfigure 5 -state disabled
212 } {
213 $m entryconfigure 3 -state normal
214 $m entryconfigure 4 -state normal
215 $m entryconfigure 5 -state normal
216 }
217 }
218
219 #
220 # proc Probe_Update_View_Buttons {}
221 #------------------------------------------------------------------------
222 # dis/enable View buttons
223 #------------------------------------------------------------------------
224 proc Probe_Update_View_Buttons {} {
225 global ascProbVect ascGlobalVect
226
227 set mb .probe.menubar.view
228
229 if {$ascGlobalVect(saveoptions) == 0} {
230 $mb entryconfigure 2 -state disabled
231 } else {
232 $mb entryconfigure 2 -state normal
233 }
234
235 }
236
237 #
238 # proc Probe_Update_ExpButtons {}
239 #------------------------------------------------------------------------
240 # dis/enable expo buttons.
241 # The export to Display menu item can be used as a sort of reporting
242 # feature, where results from the probe can be embedded into the display.
243 #------------------------------------------------------------------------
244 proc Probe_Update_ExpButtons {} {
245 global ascProbVect
246 set m $ascProbVect(expoBtn)
247
248 if {[$ascProbVect(vbox) size] == 0} {
249 $m entryconfigure 0 -state disabled
250 $m entryconfigure 1 -state disabled
251 } {
252 $m entryconfigure 0 -state normal
253 $m entryconfigure 1 -state normal
254 }
255 }
256
257
258 #
259 # proc Probe_Import {collection name args}
260 #------------------------------------------------------------------------
261 # Send named item to probe. collection may be
262 # 'new', 'current' or the number of an existing collection.
263 # Collections number consecutively from 0 as they are created.
264 # If args is not empty, it must be a well-formed filter-list for
265 # __probe add
266 # This function should be the only hub-notifying and window updating
267 # functions. All other import functions should be wrappers to this.
268 #------------------------------------------------------------------------
269 proc Probe_Import {collection name args} {
270 global ascProbVect
271 # puts "Probe_Import $collection $name $args"
272 set logcollection $collection
273 if {$collection == "" || $name ==""} {
274 return
275 }
276 if {$collection == "current"} {
277 set collection $ascProbVect(collection)
278 }
279 if {$collection == "new"} {
280 set collection [Probe_do_NewBuffer]
281 }
282 if {$collection <0 || $collection > $ascProbVect(collection)} {
283 Script_Raise_Alert \
284 "Probe_Import called with bad collection number $collection."
285 }
286 set commandstring "__probe add $collection "
287 append commandstring \{ $name \}
288 foreach i [stripbraces $args] {
289 append commandstring " $i"
290 }
291 eval $commandstring
292 Probe_Update $collection
293 if {$ascProbVect(visibility)} {
294 newraise $ascProbVect(windowname);
295 }
296 HUB_Message_to_HUB INSTPROBED $logcollection $name $args
297 }
298
299 #
300 # Probe_Import_List
301 #------------------------------------------------------------------------
302 # imports a list of complete names
303 #------------------------------------------------------------------------
304 proc Probe_Import_List {number list} {
305 foreach i $list {
306 Probe_Import $number $i
307 }
308 }
309
310 #
311 # proc Probe_Import_Filtered {caller name {automatic 0}}
312 #------------------------------------------------------------------------
313 # caller is the name of the toplevel window calling this function.
314 # Send instances in named subtree to probe.
315 # if automatic, then no dialog is used to get filter options.
316 # collections are C structures.
317 #------------------------------------------------------------------------
318 proc Probe_Import_Filtered {caller name {automatic 0}} {
319 global ascProbVect
320 global ascProbImportVect
321
322 set ascProbImportVect(rootname) $name
323 set ascProbImportVect(rootname.choices) $ascProbImportVect(rootname)
324 set ascProbImportVect(Buffer.choices) "current new"
325 set len $ascProbVect(maxbufnum)
326 for {set c 0} {$c <= $len} {incr c} {
327 append ascProbImportVect(Buffer.choices) " $c"
328 }
329 set ascProbImportVect(title) "Filtering "
330 append ascProbImportVect(title) $ascProbImportVect(rootname)
331 if {$automatic == 0} {
332 set ascParPageVect(btn_font) $ascProbVect(font)
333 set ascParPageVect(lbl_font) $ascProbVect(font)
334 ascParPage ascProbImportVect [setpos $caller 0 0] 1
335 if {$ascProbImportVect(__,cancelled)} {
336 return
337 }
338 }
339 set filter ""
340 foreach i $ascProbImportVect(filterlist) {
341 lappend filter $ascProbImportVect($i)
342 }
343 Probe_Import $ascProbImportVect(Buffer) $name $filter
344 set ascProbImportVect(Buffer) current
345 }
346
347
348 #
349 #---------------------------------------------------------------------------
350 #buffer management stuff
351 #---------------------------------------------------------------------------
352
353 #
354 # proc ProbeSwitchToNewBuf {{fname ""}}
355 #---------------------------------------------------------------------------
356 # ascProbVect(buffile.$num) the filename of numbered buffer
357 # ascProbVect(mainframe) the name of the parent for all probe_box widgets
358 # ascProbVect(collection) the number of the buffer in use currently
359 #
360 # switches to the numbered buffer. if the buffer isn't open,
361 # creates it. If fname is given != "" on a closed buffer,
362 # will read the buffer from disk, eventually...
363 # as we can see, this function needs to be decomposed.
364 #---------------------------------------------------------------------------
365 proc ProbeSwitchToNewBuf {{fname ""}} {
366 global ascProbVect ascGlobalVect
367
368 set num [__probe expand]
369 set ascProbVect(maxbufnum) $num
370 set filename "foobar"
371 set parentname $ascProbVect(mainframe)
372 if {$fname == ""} {
373 set filename NoName$num.a4p
374 set ascProbVect(buffile.$num) $filename
375 set ascProbVect(bufopen.$num) 0
376 } else {
377 set filename $fname
378 }
379 set oldnum $ascProbVect(collection)
380 set oldbufname .probe_box_$oldnum
381 catch {pack forget $parentname$oldbufname}
382 set ascProbVect(collection) $num
383 set ascProbVect(filename) $filename
384 set ascProbVect(vbox) $parentname.probe_box_$num.listbox1
385
386 set winlist [build_probebox $parentname $num $ascProbVect(font)]
387 Probe_bindListbox $winlist.listbox1
388
389 # pack widget $parentname
390 pack append $parentname \
391 $parentname.probe_box_$num {top frame center expand fill}
392
393 $ascProbVect(fileBtn) add command \
394 -command "ProbeSwitchToOldBuf $num $filename" \
395 -label $filename
396 set ascProbVect(bufopen.$num) 1
397 $parentname.probe_box_$num.listbox1 insert end {}
398
399 set ascProbVect(maxbufnum) $num
400 update
401 update idletasks
402 }
403
404
405 proc ProbeSwitchToOldBuf {num fname} {
406 global ascProbVect
407
408 set parentname $ascProbVect(mainframe)
409 set oldnum $ascProbVect(collection)
410 set oldbufname .probe_box_$oldnum
411 catch {pack forget $parentname$oldbufname}
412 set ascProbVect(collection) $num
413 set ascProbVect(filename) $fname
414 set ascProbVect(vbox) $parentname.probe_box_$num.listbox1
415 pack append $parentname \
416 $parentname.probe_box_$num {top frame center expand fill}
417 Probe_Update $num
418 update
419 update idletasks
420 }
421
422
423 # proc Probe_do_NewBuffer
424 #------------------------------------------------------------------------
425 # open a new buffer named NoNameN.a4p
426 # where N is the current max buffer number
427 #------------------------------------------------------------------------
428 proc Probe_do_NewBuffer {} {
429 global ascProbVect
430 set num [__probe size]
431 ProbeSwitchToNewBuf
432 return $num
433 }
434
435 #
436 # proc Probe_load_file {file bufnumber}
437 #------------------------------------------------------------------------
438 # collection names read from file to collection number given
439 # collection must already exist. returns the number of errors.
440 #------------------------------------------------------------------------
441 proc Probe_load_file {filename bufnum} {
442 global ascProbVect
443 if {$ascProbVect(maxbufnum) < $bufnum} {
444 Script_Raise_Alert "Cannot read into nonexistent probe buffer $bufnum"
445 return 1
446 }
447 set fname [file nativename $filename]
448 if {[file isfile $fname] && [file readable $fname]} { } else {
449 set err "Cannot read probe names file "
450 append err $fname
451 Script_Raise_Alert $err
452 return 1
453 }
454 set ec 0
455 if {[catch {
456 set cid [open $fname r]
457 set input [read -nonewline $cid]
458 close $cid
459 foreach i $input {
460 if {$i != "" && [string index $i 0] != "#"} {
461 if {[catch {__probe add $bufnum $i} err]} {
462 incr ec
463 }
464 }
465 }
466 } msg]} {
467 Script_Raise_Alert "Error reading values file"
468 return 1;
469 }
470 catch {__probe update $bufnum}
471 set ascProbVect(filename) $fname
472 return $ec
473 }
474
475 #
476 # proc Probe_do_Read {}
477 #------------------------------------------------------------------------
478 # move names from file to current collection
479 #------------------------------------------------------------------------
480 proc Probe_do_ReadFile {} {
481 global ascProbVect asc_tkfbox ascGlobalVect
482 set defaultname [file dirname $ascProbVect(filename)]
483 set asc_tkfbox(otherdirs) $ascGlobalVect(librarypathdirs)
484 set filename [tk_getOpenFile \
485 -defaultextension "" \
486 -filetypes $ascProbVect(filetypes) \
487 -initialdir $defaultname \
488 -parent $ascProbVect(windowname)\
489 -title {Read saved names file}]
490
491 if {$filename == "" && $asc_tkfbox(cancelled)==0} {
492 set err "Cannot read \"\""
493 Script_Raise_Alert $err
494 return
495 }
496 if {$asc_tkfbox(cancelled)} {
497 return
498 }
499 if {[file isdirectory $filename]} {
500 set err "Cannot read names from directory "
501 append err $filename
502 Script_Raise_Alert $err
503 return
504 }
505 Probe_load_file $filename $ascProbVect(collection)
506 Probe_Update $ascProbVect(collection)
507 }
508
509 #
510 # proc Probe_write {col file}
511 #------------------------------------------------------------------------
512 # dump specified collection names to file named.
513 #------------------------------------------------------------------------
514 proc Probe_write {col file} {
515 set cid [open $file w+]
516 puts -nonewline $cid "#$col\{"
517 puts -nonewline $cid $file
518 puts $cid "\}"
519 set max [__probe size $col]
520 for {set i 0} {$i < $max} {incr i} {
521 puts -nonewline "$col $i "
522 puts [__probe name $col $i]
523 puts -nonewline $cid "\{"
524 puts -nonewline $cid [__probe name $col $i]
525 puts $cid "\}"
526 }
527 close $cid
528 puts -nonewline stdout "Wrote "
529 puts stdout $file
530 }
531
532 #
533 # proc Probe_do_WriteBuf {}
534 #------------------------------------------------------------------------
535 # dump current collection names to associated file.
536 #------------------------------------------------------------------------
537 proc Probe_do_WriteBuf {} {
538 global ascProbVect
539 set col $ascProbVect(collection)
540 if {[__probe size $col]} {
541 if {[file exists $ascProbVect(buffile.$col)]} {
542 if {[file writable $ascProbVect(buffile.$col)]} {
543 # fsbox takes care of overwrite query
544 Probe_write $col $ascProbVect(buffile.$col)
545 } else {
546 set mess "File "
547 append mess $ascProbVect(buffile.$col)
548 append mess " is not writable"
549 Script_Raise_Alert $mess FYI
550 }
551 } else {
552 Probe_write $col $ascProbVect(buffile.$col)
553 }
554 } else {
555 Script_Raise_Alert "Empty probe $col cannot be saved" "FYI"
556 }
557 }
558
559 #
560 # proc Probe_do_WriteBufAs {}
561 #------------------------------------------------------------------------
562 # dump current collection names to user specified file
563 #------------------------------------------------------------------------
564 proc Probe_do_WriteBufAs {} {
565 global ascProbVect asc_tkfbox
566 set col $ascProbVect(collection)
567 if {[__probe size $col]} {
568 set defaultname $ascProbVect(filename)
569 set filename [tk_getSaveFile \
570 -defaultextension "" \
571 -filetypes $ascProbVect(filetypes) \
572 -initialfile $defaultname \
573 -parent .probe \
574 -title {Save probe names AS}]
575 if {$filename == "" && !$asc_tkfbox(cancelled)} {
576 Script_Raise_Alert "No file name given. Not saved" "FYI"
577 }
578 set fname [file nativename $filename]
579 if {[file exists $fname]} {
580 if {[file writable $fname]} {
581 # fsbox takes care of overwrite query
582 Probe_write $col $fname
583 } else {
584 set mess "File "
585 append mess $fname
586 append mess " is not writable"
587 Script_Raise_Alert $mess FYI
588 }
589 } else {
590 Probe_write $col $fname
591 }
592 } else {
593 Script_Raise_Alert "Empty probe $col cannot be saved" "FYI"
594 }
595 }
596
597 #
598 # proc Probe_do_Print {}
599 #------------------------------------------------------------------------
600 # dump collection view to file
601 #------------------------------------------------------------------------
602 proc Probe_do_Print {} {
603 global ascProbVect
604 $ascProbVect(vbox) selection clear 0 end
605 Print_configure ascProbVect(windowname)
606 if {[Print_cancelcheck]} {
607 return
608 }
609 DispPrint [DispWriteSelection $ascProbVect(vbox)]
610 HUB_Message_to_HUB WINDOWPRINTED PROBE
611 }
612
613 #
614 # proc Probe_Get_Selection {collection}
615 #------------------------------------------------------------------------
616 # returns current probe selection
617 #------------------------------------------------------------------------
618 proc Probe_Get_Selection {collection} {
619 global ascProbVect;
620 set sel_list [$ascProbVect(vbox) curselection]
621 return $sel_list;
622 }
623
624 #
625 # proc Probe_Update {collection}
626 #------------------------------------------------------------------------
627 # stuff probe window of the collection given
628 #------------------------------------------------------------------------
629 proc Probe_Update {collection} {
630 global ascProbVect
631 ascclearlist $ascProbVect(vbox)
632 foreach item [__probe get $collection] {
633 $ascProbVect(vbox) insert end $item
634 }
635 }
636
637 # proc Probe_Remove_Pattern
638 #------------------------------------------------------------------------
639 # This function will take a pattern and remove all things that
640 # match the pattern from the probe. This might be used to
641 # say remove : everything that matches T*, or lower_bound etc.
642 # It accepts a list of indices, eliminates what does not match
643 # and returns the modified list to be used by Probe_Delete.
644 # Assumes that we DONT have disjoint listbox selections.
645 # Remember that we always count from 1 up on the C-side of
646 # things.
647 #------------------------------------------------------------------------
648 proc Probe_Remove_Pattern {list pattern} {
649 Script_Raise_Alert "Probe_Remove_Pattern not implemented"
650 }
651
652 #
653 # proc Probe_do_SelectAll
654 #------------------------------------------------------------------------
655 # function to select all in probe
656 #------------------------------------------------------------------------
657 proc Probe_do_SelectAll {} {
658 global ascProbVect
659 $ascProbVect(vbox) select set 0 end
660 }
661
662
663 #
664 # proc Probe_do_RemoveSelections
665 #------------------------------------------------------------------------
666 # removes the selected item in the current collection.
667 # selection may be disjoint.
668 #------------------------------------------------------------------------
669 proc Probe_do_RemoveSelections {} {# The command bound to the MenuButton
670
671 global ascProbVect
672 set collection $ascProbVect(collection)
673 set delete_list "[Probe_Get_Selection $collection]"
674 if {$delete_list != ""} {
675 set pccommand "__probe clear $collection $delete_list"
676 eval $pccommand
677 Probe_Update $collection
678 }
679 }
680
681 #
682 # proc Probe_do_RemoveAll
683 #------------------------------------------------------------------------
684 # delete all probe stuff in current buffer.
685 #------------------------------------------------------------------------
686 proc Probe_do_RemoveAll {} {
687 global ascProbVect
688 set collection $ascProbVect(collection)
689 __probe clear $collection
690 Probe_Update $collection
691 }
692
693 #
694 # proc Probe_do_RemoveUncertain
695 #------------------------------------------------------------------------
696 # delete all uncertain stuff in current buffer.
697 #------------------------------------------------------------------------
698 proc Probe_do_RemoveUncertain {} {
699 global ascProbVect
700 set collection $ascProbVect(collection)
701 __probe trash
702 Probe_Update $collection
703 }
704
705 #
706 # proc Probe_do_Copy
707 #------------------------------------------------------------------------
708 # Copy current probe to clipboard
709 #------------------------------------------------------------------------
710 proc Probe_do_Copy {} {
711 global ascProbVect
712 asc_export_selection $ascProbVect(vbox)
713 event generate $ascProbVect(vbox) <<Copy>>
714 }
715
716
717 #
718 # proc Probe_HandleInstanceMoved
719 #------------------------------------------------------------------------
720 # This procedure will be registered with the HUB.
721 # Whenever an instance is ABOUT to moved in memory, such as with a merge,
722 # refine or are_alike, This procedure will be invoked first so that
723 # ALL instances become uncertain in all probes.
724 #------------------------------------------------------------------------
725 proc Probe_HandleInstanceMoved {args} {
726 global ascProbVect
727 __probe invalidate
728 Probe_Update $ascProbVect(collection)
729 }
730
731 #
732 # proc Probe_HandleNewInstances
733 #------------------------------------------------------------------------
734 # This procedure will be registered with the HUB.
735 # Whenever new instances are in memory, such as after a merge,
736 # refine or are_alike, This procedure will be invoked first so that
737 # uncertain instances become defined again.
738 #------------------------------------------------------------------------
739 proc Probe_HandleNewInstances {args} {
740 global ascProbVect
741 __probe update
742 Probe_Update $ascProbVect(collection)
743 }
744
745 #
746 # proc Probe_HandleSimsDelete
747 #------------------------------------------------------------------------
748 # This procedure will be registered with the HUB.
749 # It removes all references i.e in all collections, for a simulation that is
750 # ABOUT to be deleted.
751 #------------------------------------------------------------------------
752 proc Probe_HandleSimsDelete {{list ""}} {
753 Probe_HandleInstanceMoved $list
754 }
755
756 #
757 # proc Probe_HandleVariableUpdated
758 #------------------------------------------------------------------------
759 # This procedure will be registered with the HUB.
760 # Whenever a variables value has changed because of:
761 # 1) solving completed.
762 # 2) a procedure has been run.
763 # 3) a variable has been assigned etc...
764 # this procedure will be invoked to update only the currently focused
765 # probe. The act of selecting a new probe collection via the radio buttons
766 # will update that collection at the given time.
767 #------------------------------------------------------------------------
768 proc Probe_HandleVariableUpdated {{list ""}} {
769 global ascProbVect
770 Probe_Update $ascProbVect(collection)
771 }
772
773 #
774 # proc Probe_do_Export2Browser {}
775 #------------------------------------------------------------------------
776 # export first of current selection in probe to browser.
777 # The browser is expected to defend itself against UNCERTAIN names.
778 #------------------------------------------------------------------------
779 proc Probe_do_Export2Browser {} {
780 global ascProbVect
781 set collection $ascProbVect(collection)
782 set ndx_list [Probe_Get_Selection $collection]
783 set ndx [lindex $ndx_list 0]
784 if {$ndx == ""} {
785 return;
786 }
787 set name [__probe name $collection $ndx]
788 if {$name == ""} {return}
789 Brow_Export_Any_2Browser $name
790 }
791
792 #
793 # proc Probe_do_Export2Display {}
794 #------------------------------------------------------------------------
795 # button. wrapper of export to display
796 # Will take each item in the probe, which is a valid tcl list,
797 # split of any braces and insert them one a time in the display
798 # window at the current insertion cursor. The information that will
799 # be exported will be the displayed information in the probe, and not
800 # pulled up from the internal C data_structure.
801 #------------------------------------------------------------------------
802 proc Probe_do_Export2Display {} {# bound to the menu_button
803 global ascProbVect ascDispVect
804
805 if {[winfo exists $ascDispVect(textBox)] == "0"} {return}
806 set collection $ascProbVect(collection)
807 set index_list [Probe_Get_Selection $collection]
808 foreach index $index_list {
809 set data [$ascProbVect(vbox) get $index]
810 $ascDispVect(textBox) insert insert $data
811 $ascDispVect(textBox) insert insert "\n"
812 }
813 newraise .display
814 }
815
816 #
817 # proc Probe_do_Help {}
818 # proc Probe_do_BindHelp {}
819 #------------------------------------------------------------------------
820 # probe help buttons
821 #------------------------------------------------------------------------
822 proc Probe_do_Help {} {
823 Help_button probe
824 }
825 proc Probe_do_BindHelp {} {
826 Help_button probe.help onprobe
827 }
828 #
829 # proc Probe_Redraw {}
830 #------------------------------------------------------------------------
831 # Redraw probe after interface restart
832 #------------------------------------------------------------------------
833 proc Probe_Redraw {} {
834 # data seems to linger across restarts, so no redraw
835 }
836
837 #
838 # proc Probe_bindListbox {probelistbox}
839 #------------------------------------------------------------------------
840 # bind probe after creation
841 #------------------------------------------------------------------------
842 proc Probe_bindListbox {w} {
843 bind $w <Button-3> {
844 set d [%W nearest %y]
845 if {$d != ""} {
846 Probe_do_SetValue $d
847 }
848 }
849 bind $w <Double-1> {
850 set d [%W nearest %y]
851 if {$d != ""} {
852 Probe_do_BrowseItem $d
853 }
854 }
855 }
856
857 #
858 # proc Probe_do_SetValue {ndx}
859 #----------------------------------------------------------------------
860 # pull up an assignment dialog. this hsould maybe pull up a parameter
861 # style page for assigning value and all assignable children.
862 #----------------------------------------------------------------------
863 proc Probe_do_SetValue {ndx} {
864 global ascProbVect
865 set name [lindex [$ascProbVect(vbox) get $ndx] 0]
866 if {[catch {qlfdid $name} errmsg]} {return}
867 Browser_do_SetValue $ascProbVect(vbox) $name
868 }
869
870 #
871 # proc Probe_do_BrowseItem {ndx}
872 #----------------------------------------------------------------------
873 # browse the selected item at line ndx in the current probe.
874 #----------------------------------------------------------------------
875 proc Probe_do_BrowseItem {ndx} {
876 global ascProbVect
877 set name [lindex [$ascProbVect(vbox) get $ndx] 0]
878 if {[catch {qlfdid $name} errmsg]} {return}
879 BROWSE $name
880 }
881
882 #------------------------------------------------------------------------
883 #------------------------------------------------------------------------
884 #
885 # User Data functions. They will be kept here until we can find a
886 # place for them to reside. These are most closely related to the
887 # probe, but only by a vague similarity.
888 #
889 #------------------------------------------------------------------------
890 #------------------------------------------------------------------------
891
892 #
893 # proc WRITE_VIRTUAL
894 #------------------------------------------------------------------------
895 # Saves the information from the specified qualified id into a virtual
896 # file with the given name. At the moment now only saves the information
897 # associated with reals.
898 #------------------------------------------------------------------------
899 proc WRITE_VIRTUAL {from to} {
900 # first set up the search instance to look at the "from" instance.
901 #
902 set nok [catch "qlfdid \{$from\}" data_or_error]
903 if {$nok} {
904 Script_Raise_Alert "$data_or_error" "Probe Error"
905 return 1;
906 }
907 # attempt to save the data.
908 #
909 set nok [catch "__userdata_save search $to" data_or_error]
910 if {$nok} {
911 Script_Raise_Alert "$data_or_error" "Probe Error"
912 return 1;
913 }
914 return 0;
915 }
916
917 #
918 # proc READ_VIRTUAL
919 #------------------------------------------------------------------------
920 # Will restore the values from the virtual file back to the instance
921 # tree. See the notes concerning writing of this virtual file.
922 #------------------------------------------------------------------------
923 proc READ_VIRTUAL {id} {
924 set nok [catch "__userdata_restore $id" data_or_error]
925 if {$nok} {
926 Script_Raise_Alert "$data_or_error" "Probe Error"
927 return 1;
928 }
929 HUB_Message_to_HUB VARIABLEUPDATED
930 return 0;
931 }
932
933 #
934 # proc Probe_UserData_HandleSimsDelete
935 #------------------------------------------------------------------------
936 # This function will be registered with the hub. It needs to be invoked
937 # under the same conditions that will require a flush of the probe.
938 #------------------------------------------------------------------------
939 proc Probe_UserData_HandleSimsDelete {args} {
940 __userdata_destroy all
941 __userdata_init
942 return 0
943 }
944
945 #
946 # proc Probe_UserData_HandleInstanceMoved
947 #------------------------------------------------------------------------
948 # This function will be registered with the hub. It needs to be invoked
949 # under the same conditions that will require a flush of the probe.
950 #------------------------------------------------------------------------
951 proc Probe_UserData_HandleInstanceMoved {args} {
952 Probe_UserData_HandleSimsDelete $args
953 return 0
954 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22