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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 571 - (show annotations) (download) (as text)
Tue May 9 00:14:59 2006 UTC (18 years, 9 months ago) by johnpye
File MIME type: text/x-tcl
File size: 31374 byte(s)
Renaming 'tcltk98' to 'tcltk', continued...
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 }

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