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

Annotation of /trunk/ascend4/TK/ProbeProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 8 months ago) by aw0a
File MIME type: text/x-tcl
File size: 31374 byte(s)
Setting up web subdirectory in repository
1 aw0a 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