973c2be1 |
1 | # Copyright (c) 1999-2014 OPEN CASCADE SAS |
b311480e |
2 | # |
973c2be1 |
3 | # This file is part of Open CASCADE Technology software library. |
b311480e |
4 | # |
d5f74e42 |
5 | # This library is free software; you can redistribute it and/or modify it under |
6 | # the terms of the GNU Lesser General Public License version 2.1 as published |
973c2be1 |
7 | # by the Free Software Foundation, with special exception defined in the file |
8 | # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT |
9 | # distribution for complete text of the license and disclaimer of any warranty. |
b311480e |
10 | # |
973c2be1 |
11 | # Alternatively, this file may be used under the terms of Open CASCADE |
12 | # commercial license or contractual agreement. |
b311480e |
13 | |
7fd59977 |
14 | # |
15 | # TK features for Draw |
16 | # |
17 | |
18 | # reload bindings |
19 | if { [info exists tk_library] } { |
20 | set version [split [info tclversion] "."] |
21 | set major [lindex ${version} 0] |
22 | set minor [lindex ${version} 1] |
23 | if { (${major} > 8) || (${major} >= 8 && ${minor} >= 4) } { |
24 | #source $tk_library/tk.tcl |
25 | } else { |
26 | source $tk_library/tk.tcl |
27 | } |
28 | } |
29 | |
ab91ab6f |
30 | #fills menu "Load" with submenus |
31 | proc fillloadmenu {} { |
32 | set chan [open [file nativename $::env(CASROOT)/src/DrawResources/DrawPlugin]] |
33 | while {[gets $chan line] >= 0} { |
34 | if {[lindex [split $line ""] 0] != "!"} { |
35 | if {[lindex [split $line ""] 0] == ""} {continue} |
36 | set plugname [lindex [split $line " "] 0] |
37 | addmenu Load "pload $plugname" "pload $plugname" |
38 | } |
39 | } |
40 | close $chan |
41 | } |
42 | |
7fd59977 |
43 | wm geometry . +10+10 |
ab91ab6f |
44 | bind . <F1> {vcommands} |
7fd59977 |
45 | |
46 | frame .mbar -relief raised -bd 2 |
47 | pack .mbar -side top -fill x |
48 | focus .mbar |
49 | |
50 | set theMenus("") "" |
51 | set Draw_MenuIndex 0 |
52 | |
53 | proc addmenuitem {menu options} { |
54 | |
55 | global theMenus Draw_MenuIndex |
56 | if {![info exists theMenus($menu)]} { |
57 | incr Draw_MenuIndex |
58 | set m .mbar.m$Draw_MenuIndex.menu |
59 | menubutton .mbar.m$Draw_MenuIndex -text $menu -menu $m |
60 | pack .mbar.m$Draw_MenuIndex -side left |
61 | menu $m |
62 | set theMenus($menu) $m |
63 | } else {set m $theMenus($menu)} |
64 | |
65 | eval $m add $options |
66 | } |
67 | |
68 | proc addmenu {menu submenu {command ""}} { |
69 | if {$command == ""} {set command $submenu} |
ab91ab6f |
70 | addmenuitem $menu "command -label {$submenu} -command {$command}" |
7fd59977 |
71 | } |
72 | |
73 | ################################# |
74 | # Menus definition |
75 | ################################# |
76 | |
77 | # the file menu |
78 | |
ab91ab6f |
79 | addmenu File "Choose Data Directory" vdatadir |
80 | addmenu File "Load Shape (restore)" vrestore |
81 | addmenu File "Load Script (source)" vsource |
82 | addmenu File Exit exit |
83 | |
84 | # the Load menu |
85 | fillloadmenu |
7fd59977 |
86 | |
87 | # the view menu |
88 | |
89 | addmenu Views axo {smallview AXON} |
90 | addmenu Views top {smallview +X+Y} |
91 | addmenu Views front {smallview +X+Z} |
92 | addmenu Views left {smallview +Y+Z} |
93 | addmenu Views 2d {smallview -2D-} |
94 | addmenuitem Views "separator" |
95 | addmenu Views mu4 |
96 | addmenu Views av2d |
97 | addmenu Views axo |
98 | addmenu Views pers |
99 | |
100 | # the display menu |
101 | |
102 | addmenu Display fit "fit; repaint" |
103 | addmenu Display 2dfit "2dfit; repaint" |
104 | addmenu Display clear |
105 | addmenu Display 2dclear |
106 | |
ab91ab6f |
107 | # the samples menu |
108 | addmenu Samples "View samples" vsample |
109 | |
110 | # the help menu |
111 | |
112 | addmenu Help "System Info" sysinfo |
113 | addmenu Help Commands vcommands |
114 | addmenu Help About about |
115 | addmenu Help "User Guide" openuserguide |
116 | |
117 | #redraw help submenu in the end of menu |
118 | proc redrawhelp {} { |
119 | global theMenus |
120 | set m $theMenus(Help) |
121 | destroy [string trimright $m ".menu"] |
122 | if [info exists theMenus(Help)] {unset theMenus(Help)} |
123 | addmenu Help "System Info" sysinfo |
124 | addmenu Help Commands vcommands |
125 | addmenu Help About about |
126 | addmenu Help "User Guide" openuserguide |
127 | } |
7fd59977 |
128 | |
129 | ################################# |
130 | # Modal dialog box |
ab91ab6f |
131 | # add OK, help, cancel buttons |
7fd59977 |
132 | ################################# |
133 | |
134 | proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} { |
135 | wm geometry $box +10+60 |
7fd59977 |
136 | button $box.ok -text ok -command "$okproc ; destroy $box" |
137 | pack $box.ok -side left |
138 | button $box.ko -text Cancel -command "$cancelproc ; destroy $box" |
139 | pack $box.ko -side right |
140 | if {$helpproc != ""} { |
141 | button $box.help -text Help -command $helpproc |
142 | pack $box.help -side right |
143 | } |
144 | grab set $box |
145 | } |
146 | |
ab91ab6f |
147 | |
148 | ################################# |
149 | # File menu procedures |
150 | ################################# |
151 | |
7fd59977 |
152 | ############################## |
153 | # |
154 | # dialbox command arg1 val1 arg2 val2 ... |
155 | # |
156 | ############################## |
157 | |
158 | proc dialbox args { |
7fd59977 |
159 | set com [lindex $args 0] |
160 | |
161 | toplevel .d |
162 | wm title .d $com |
163 | |
164 | # com will be the command |
165 | set com "eval $com" |
166 | |
167 | # create entries for the arguments |
168 | set n [llength $args] |
169 | |
170 | for {set i 1} {$i < $n} {incr i 2} { |
171 | |
172 | frame .d.a$i |
173 | label .d.a$i.l -text [lindex $args $i] |
174 | entry .d.a$i.e -relief sunken |
175 | .d.a$i.e insert end [lindex $args [expr $i+1]] |
176 | pack .d.a$i.l -side left |
177 | pack .d.a$i.e -side right |
178 | pack .d.a$i -side top -fill x |
179 | |
180 | append com { [} ".d.a$i.e get" {]} |
181 | } |
182 | append com ";repaint" |
183 | |
184 | modaldialog .d $com "help [lindex $args 0]" |
ab91ab6f |
185 | } |
186 | proc sdatadir {d} { |
187 | global Draw_DataDir |
188 | set Draw_DataDir $d |
7fd59977 |
189 | } |
190 | |
ab91ab6f |
191 | proc vdatadir {} { |
192 | global Draw_DataDir |
193 | sdatadir [tk_chooseDirectory -title "Data Directory" -initialdir $Draw_DataDir] |
194 | } |
7fd59977 |
195 | |
ab91ab6f |
196 | proc rresto {f} { |
197 | if {[file exists $f]} { |
198 | if {! [file isdirectory $f]} { |
199 | puts "restore $f [file tail $f]" |
200 | uplevel \#0 "restore $f [file tail $f]" |
201 | repaint |
7fd59977 |
202 | } |
ab91ab6f |
203 | } |
7fd59977 |
204 | } |
205 | |
ab91ab6f |
206 | proc vrestore {} { |
207 | global Draw_DataDir |
208 | rresto [tk_getOpenFile -title "Load Shape (restore)" -filetypes {{{BREP} {.brep}}} -initialdir $Draw_DataDir] |
209 | } |
210 | |
211 | |
212 | proc ssour {f} { |
213 | global Draw_Source |
214 | if {[file exists $f]} { |
215 | set Draw_Source $f |
7fd59977 |
216 | if {! [file isdirectory $f]} { |
ab91ab6f |
217 | puts "source $f [file tail $f]" |
218 | uplevel \#0 "source $f" |
7fd59977 |
219 | } |
ab91ab6f |
220 | } |
7fd59977 |
221 | } |
222 | |
ab91ab6f |
223 | set Draw_Source [pwd] |
224 | proc vsource {} { |
225 | global Draw_Source |
226 | ssour [tk_getOpenFile -title "Load Script (source)" -filetypes {{{All Files} *}} -initialdir Draw_Source] |
227 | } |
7fd59977 |
228 | |
ab91ab6f |
229 | #Creates a "Samples" window |
230 | proc vsamples {} { |
231 | #create list {{category} {title} {filename}} |
232 | set alistofthree "" |
233 | foreach fname [file nativename [glob -path $::env(CASROOT)/samples/tcl/ *]] { |
234 | if {[lindex [split $fname "."] end] != "tcl"} {continue} |
235 | set chan [open $fname] |
236 | set istitlefound 0 |
237 | while {[gets $chan line] >= 0} { |
238 | if {[lindex [split $line " "] 0] == "#Category:"} { |
239 | set acategory [string trimleft $line "#Category: "] |
240 | } |
241 | if {[lindex [split $line " "] 0] == "#Title:"} { |
242 | set atitle [string trimleft $line "#Title: "] |
243 | lappend alistofthree $acategory $atitle $fname |
244 | incr istitlefound |
245 | break |
246 | } |
7fd59977 |
247 | } |
ab91ab6f |
248 | close $chan |
249 | if {$istitlefound == 0} { |
250 | lappend alistofthree Other "[lindex [split $fname \\] end]" $fname |
7fd59977 |
251 | } |
ab91ab6f |
252 | } |
253 | #create window |
254 | toplevel .samples |
255 | wm title .samples "Samples" |
256 | wm geometry .samples +0+0 |
257 | wm minsize .samples 800 600 |
258 | frame .samples.right |
259 | frame .samples.left |
260 | frame .samples.right.textframe |
261 | frame .samples.right.botframe |
262 | ttk::treeview .samples.left.tree -selectmode browse -yscrollcommand {.samples.left.treescroll set} |
263 | pack .samples.left.tree -fill both -expand 1 -side left |
264 | .samples.left.tree column #0 -minwidth 200 |
265 | .samples.left.tree heading #0 -text "Samples" |
266 | pack .samples.right -side right -fill both -expand 1 -padx 10 -pady 10 |
267 | pack .samples.left -side left -padx 10 -pady 10 -fill both |
268 | pack .samples.right.textframe -side top -fill both -expand 1 |
269 | pack .samples.right.botframe -side bottom -fill both -expand 1 |
270 | text .samples.right.textframe.text -yscrollcommand {.samples.right.textframe.scroll set} -xscrollcommand {.samples.right.botframe.scrollx set} -wrap none -width 40 -height 32 |
271 | pack .samples.right.textframe.text -fill both -side left -expand 1 |
272 | .samples.right.textframe.text delete 0.0 end |
273 | .samples.right.textframe.text configure -state disabled |
274 | set i 1 |
275 | foreach {acat title fnam} $alistofthree { |
276 | if [.samples.left.tree exists $acat] { |
277 | .samples.left.tree insert $acat end -id $title -text $title -tags "selected$i" |
278 | .samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}" |
279 | incr i |
280 | continue |
281 | } else { |
282 | .samples.left.tree insert {} end -id $acat -text $acat |
283 | .samples.left.tree insert $acat end -id $title -text $title -tags "selected$i" |
284 | .samples.left.tree tag bind selected$i <1> "fillsampletext {$fnam}" |
285 | incr i |
7fd59977 |
286 | } |
ab91ab6f |
287 | } |
288 | scrollbar .samples.right.textframe.scroll -command {.samples.right.textframe.text yview} |
289 | scrollbar .samples.left.treescroll -command {.samples.left.tree yview} |
290 | scrollbar .samples.right.botframe.scrollx -command {.samples.right.textframe.text xview} -orient horizontal |
291 | pack .samples.right.textframe.scroll -side right -fill y |
292 | pack .samples.right.botframe.scrollx -side top -fill x |
293 | pack .samples.left.treescroll -side right -fill y |
294 | button .samples.right.botframe.button -text "Run sample" -state disabled |
295 | pack .samples.right.botframe.button -fill none -pady 10 |
7fd59977 |
296 | } |
297 | |
ab91ab6f |
298 | #Fills the textbox in "Samples" window |
299 | proc fillsampletext {fname} { |
300 | .samples.right.botframe.button configure -state normal -command "lower .samples;catch {vclose ALL};catch {vremove -all}; catch {vclear}; source {$fname}" |
301 | .samples.right.textframe.text configure -state normal |
302 | .samples.right.textframe.text delete 0.0 end |
303 | set chan [open "$fname"] |
304 | while {[gets $chan line] >= 0} { |
305 | .samples.right.textframe.text insert end "$line\n" |
306 | } |
307 | close $chan |
308 | .samples.right.textframe.text configure -state disabled |
309 | } |
7fd59977 |
310 | |
ab91ab6f |
311 | #Creates a "Commands help" window |
312 | proc vcommands {} { |
313 | global Draw_Groups Find_Button_Click_Count Entry_Cache |
314 | set Find_Button_Click_Count 0 |
315 | set Entry_Cache "" |
316 | toplevel .commands |
317 | focus .commands |
318 | wm minsize .commands 800 600 |
319 | wm title .commands "Commands help" |
320 | wm geometry .commands +0+0 |
321 | frame .commands.t |
322 | frame .commands.left |
323 | ttk::treeview .commands.left.tree -selectmode browse -yscrollcommand {.commands.left.treescroll set} |
324 | .commands.left.tree column #0 -width 300 |
325 | .commands.left.tree heading #0 -text "Help treeview" |
326 | pack .commands.left.tree -expand 1 -fill both -side left |
327 | pack .commands.t -side right -fill both -expand 1 -padx 10 -pady 10 |
328 | pack .commands.left -side left -fill both -padx 10 -pady 10 |
329 | pack [frame .commands.t.top] -side top -fill x -padx 10 -pady 10 |
330 | text .commands.t.text -yscrollcommand {.commands.t.scroll set} -width 40 |
331 | .commands.t.text delete 0.0 end |
332 | pack .commands.t.text -fill both -side left -expand 1 |
333 | .commands.t.text configure -state disabled |
334 | pack [entry .commands.t.top.e -width 20] -side left |
335 | pack [button .commands.t.top.findcom -text "Find command" -command vhelpsearch] -side left -padx 10 |
336 | pack [button .commands.t.top.textfind -text "Find in text" -command "vhelptextsearch; incr Find_Button_Click_Count"] -side left |
337 | set i 1 |
338 | set j 100 |
339 | set newgroupinx 0 |
340 | foreach h [lsort [array names Draw_Groups]] { |
341 | .commands.left.tree insert {} end -id $i -text $h -tags "info$i" |
342 | .commands.left.tree tag bind info$i <1> "vcomhelp {$h}" |
343 | set newgroupinx $j |
344 | foreach f [lsort $Draw_Groups($h)] { |
345 | .commands.left.tree insert $i end -id $j -text $f -tags "selected$j" |
346 | .commands.left.tree tag bind selected$j <1> "vcomhelp {$h} $j $newgroupinx" |
347 | incr j |
348 | } |
349 | incr i |
350 | } |
351 | scrollbar .commands.t.scroll -command {.commands.t.text yview} |
352 | scrollbar .commands.left.treescroll -command {.commands.left.tree yview} |
353 | pack .commands.t.scroll -side right -fill y |
354 | pack .commands.left.treescroll -side right -fill y -expand 1 |
355 | #hotkeys |
356 | bind .commands.t.top.e <Return> {vhelpsearch} |
357 | bind .commands <Control-f> {focus .commands.t.top.e} |
358 | bind .commands <Control-F> {focus .commands.t.top.e} |
359 | bind .commands <Escape> {destroy .commands} |
360 | } |
361 | |
362 | ############################################################ |
363 | # Fills the textbox in "Commands help" window |
364 | # $h -group of commands to display |
365 | # $selindex - index of selected item in the treeview |
366 | # $startindex - index of item int the treeview to start from |
367 | ############################################################ |
368 | proc vcomhelp {h {selindex -1} {startindex 0}} { |
369 | global Draw_Helps Draw_Groups |
370 | set highlighted false |
371 | .commands.t.text configure -state normal |
372 | .commands.t.text delete 1.0 end |
373 | foreach f [lsort $Draw_Groups($h)] { |
374 | if {$startindex == $selindex} { |
375 | .commands.t.text insert end "$f : $Draw_Helps($f)\n\n" "highlightline" |
376 | incr startindex |
377 | set highlighted true |
378 | continue |
379 | } |
380 | .commands.t.text insert end "$f : $Draw_Helps($f)\n\n" |
381 | incr startindex |
382 | } |
383 | .commands.t.text tag configure highlightline -background yellow -relief raised |
384 | .commands.t.text configure -state disabled |
385 | if {$highlighted == true} {.commands.t.text see highlightline.last} |
386 | } |
7fd59977 |
387 | |
ab91ab6f |
388 | #Creates a "About" window |
389 | proc about {} { |
390 | toplevel .about |
391 | focus .about |
392 | wm resizable .about 0 0 |
393 | wm title .about "About" |
394 | set screenheight [expr {int([winfo screenheight .]*0.5-200)}] |
395 | set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}] |
396 | wm geometry .about 400x200+$screenwidth+$screenheight |
397 | image create photo occlogo -file $::env(CASROOT)/src/DrawResources/OCC_logo.png -format png |
398 | frame .about.logo -bg red |
399 | frame .about.links -bg blue |
400 | frame .about.copyright |
401 | pack .about.logo -side top -fill both |
402 | pack .about.links -fill both |
403 | pack .about.copyright -side top -fill both |
404 | label .about.logo.img -image occlogo |
405 | pack .about.logo.img -fill both |
406 | text .about.links.text -bg lightgray -fg blue -height 1 -width 10 |
407 | .about.links.text insert end "http://www.opencascade.com/" "link1" |
408 | .about.links.text tag bind link1 <1> "_launchBrowser http://www.opencascade.com/" |
409 | .about.links.text tag bind link1 <Enter> ".about.links.text configure -cursor hand2" |
410 | .about.links.text tag bind link1 <Leave> ".about.links.text configure -cursor arrow" |
411 | .about.links.text tag configure link1 -underline true -justify center |
412 | pack .about.links.text -fill both |
413 | label .about.copyright.text -text "Copyright (c) 1999-2014 OPEN CASCADE SAS" |
414 | button .about.button -text "OK" -command "destroy .about" |
415 | pack .about.button -padx 10 -pady 10 |
416 | pack .about.copyright.text |
417 | .about.links.text configure -state disabled |
418 | grab .about |
419 | bind .about <Return> {destroy .about} |
420 | } |
7fd59977 |
421 | |
ab91ab6f |
422 | #Executes files and hyperlinks |
423 | proc launchBrowser url { |
424 | global tcl_platform |
7fd59977 |
425 | |
ab91ab6f |
426 | if {$tcl_platform(platform) eq "windows"} { |
427 | set command [list {*}[auto_execok start] {}] |
428 | } elseif {$tcl_platform(os) eq "Darwin"} { |
429 | set command [list open] |
430 | } else { |
431 | set command [list xdg-open] |
432 | } |
433 | exec {*}$command $url & |
7fd59977 |
434 | } |
435 | |
ab91ab6f |
436 | #Safe execution of files and hyperlinks |
437 | proc _launchBrowser {url} { |
438 | if [catch {launchBrowser $url} err] { |
439 | tk_messageBox -icon error -message "error '$err' with '$command'" |
440 | } |
441 | } |
442 | ################################################################ |
443 | # This procedure tries to open an userguide on Draw Harness in pdf format |
444 | # If there is no a such one, then tries to open it in html format |
445 | # Else opens a site with this guide |
446 | ################################################################ |
447 | proc openuserguide {} { |
448 | if [file exists $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf] { |
449 | _launchBrowser $::env(CASROOT)/doc/pdf/user_guides/occt_test_harness.pdf |
450 | } elseif [file exists $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html] { |
451 | _launchBrowser $::env(CASROOT)/doc/overview/html/occt_user_guides__test_harness.html |
452 | } else { |
453 | _launchBrowser {http://dev.opencascade.org/doc/overview/html/occt_user_guides__test_harness.html} |
7fd59977 |
454 | } |
7fd59977 |
455 | } |
456 | |
ab91ab6f |
457 | #Search through commands and display the result |
458 | proc vhelpsearch {} { |
459 | global Draw_Groups Entry_Cache |
460 | set searchstring [.commands.t.top.e get] |
461 | set i 1 |
462 | set j 100 |
463 | set newgroupinx 0 |
464 | set isfound 0 |
465 | foreach h [lsort [array names Draw_Groups]] { |
466 | set newgroupinx $j |
467 | foreach f [lsort $Draw_Groups($h)] { |
468 | if {$f == $searchstring} { |
469 | incr isfound |
470 | .commands.left.tree see $j |
471 | .commands.left.tree selection set $j |
472 | vcomhelp $h $j $newgroupinx |
473 | break |
474 | } |
475 | incr j |
7fd59977 |
476 | } |
ab91ab6f |
477 | incr i |
478 | } |
479 | if {$isfound == 0} { |
480 | errorhelp "No help found for '$searchstring'!" |
481 | } else {set Entry_Cache ""} |
7fd59977 |
482 | } |
483 | |
ab91ab6f |
484 | #Displays an error window with $errstring inside |
485 | proc errorhelp {errstring} { |
486 | toplevel .errorhelp |
487 | focus .errorhelp |
488 | wm resizable .errorhelp 0 0 |
489 | wm title .errorhelp "Error" |
490 | set screenheight [expr {int([winfo screenheight .]*0.5-200)}] |
491 | set screenwidth [expr {int([winfo screenwidth .]*0.5-200)}] |
492 | wm geometry .errorhelp +$screenwidth+$screenheight |
493 | text .errorhelp.t -width 40 -height 5 |
494 | .errorhelp.t insert end $errstring |
495 | button .errorhelp.button -text "OK" -command "destroy .errorhelp" |
496 | pack .errorhelp.t |
497 | .errorhelp.t configure -state disabled |
498 | pack .errorhelp.button -padx 10 -pady 10 |
499 | bind .errorhelp <Return> {destroy .errorhelp} |
500 | grab .errorhelp |
7fd59977 |
501 | } |
502 | |
ab91ab6f |
503 | #Search through text of help and display the result |
504 | proc vhelptextsearch {} { |
505 | global Draw_Helps Draw_Groups Find_Button_Click_Count Entry_Cache End_of_Search |
506 | set searchstring [.commands.t.top.e get] |
507 | if {$Entry_Cache != $searchstring} { |
508 | set Find_Button_Click_Count 0 |
509 | set End_of_Search 0 |
510 | set Entry_Cache $searchstring |
511 | } |
512 | if {$End_of_Search} { |
513 | errorhelp "No more '$searchstring' found!" |
514 | return |
515 | } |
516 | .commands.t.text configure -state normal |
517 | .commands.t.text delete 0.0 end |
518 | set i 0 |
519 | set isfound 0 |
520 | foreach h [lsort [array names Draw_Groups]] { |
521 | foreach f [lsort $Draw_Groups($h)] { |
522 | if [string match *$searchstring* $Draw_Helps($f)] { |
523 | incr i |
524 | if {$i > $Find_Button_Click_Count+1} {incr isfound; break} |
525 | .commands.t.text insert end "$f : " |
526 | foreach line [list $Draw_Helps($f)] { |
527 | foreach word [split $line " "] { |
528 | if [string match *$searchstring* $word] { |
529 | .commands.t.text insert end "$word" "highlightword" |
530 | .commands.t.text insert end " " |
531 | continue |
532 | } |
533 | .commands.t.text insert end "$word " |
534 | } |
535 | } |
536 | .commands.t.text insert end \n\n |
537 | } |
7fd59977 |
538 | } |
ab91ab6f |
539 | } |
540 | if {!$isfound} { |
541 | incr End_of_Search |
542 | } |
543 | .commands.t.text tag configure highlightword -background yellow -relief raised |
544 | .commands.t.text see end |
7fd59977 |
545 | } |
546 | |
ab91ab6f |
547 | #Create a "System information" window |
548 | proc sysinfo {} { |
549 | toplevel .info |
550 | wm title .info "System information" |
551 | wm resizable .info 0 0 |
552 | pack [frame .info.top] -side top -fill both -padx 5 -pady 10 |
553 | pack [frame .info.bot] -side bottom -fill both -padx 5 -pady 10 |
554 | pack [frame .info.top.left] -side left -fill both -padx 5 -pady 10 |
555 | pack [frame .info.top.mid] -side left -fill both -padx 5 -pady 10 |
556 | pack [frame .info.top.right] -side left -fill both -padx 5 -pady 10 |
557 | pack [label .info.top.left.label -text "OCCT build configuration "] |
558 | pack [label .info.top.mid.label -text "Memory info"] |
559 | pack [label .info.top.right.label -text "OpenGL info"] |
560 | pack [text .info.top.left.text -width 50 -height 20] |
561 | pack [text .info.top.mid.text -width 50 -height 20] |
562 | pack [text .info.top.right.text -width 50 -height 20] |
563 | pack [button .info.bot.button -text "Update" -command rescaninfo] |
564 | pack [button .info.bot.close -text "Close" -command "destroy .info"] -pady 10 |
565 | rescaninfo |
566 | } |
567 | |
568 | #Updates information in "System information" window |
569 | proc rescaninfo {} { |
570 | .info.top.left.text configure -state normal |
571 | .info.top.mid.text configure -state normal |
572 | .info.top.right.text configure -state normal |
573 | .info.top.left.text delete 0.0 end |
574 | .info.top.mid.text delete 0.0 end |
575 | .info.top.right.text delete 0.0 end |
576 | .info.top.left.text insert end [dversion] |
577 | .info.top.mid.text insert end [meminfo] |
578 | set glinfo "" |
579 | if [catch {vglinfo} err] { |
580 | if {$err == ""} { |
581 | .info.top.right.text insert end "No active view. Please call vinit." |
582 | } else { |
583 | .info.top.right.text insert end "VISUALIZATION is not loaded. Please call pload VISUALIZATION" |
584 | } |
585 | } else { |
586 | .info.top.right.text insert end [vglinfo] |
587 | } |
588 | .info.top.left.text configure -state disabled |
589 | .info.top.mid.text configure -state disabled |
590 | .info.top.right.text configure -state disabled |
7fd59977 |
591 | } |