1#! /bin/sh 2# \ 3 exec wish $0 ${1+"$@"} 4 5# BEGIN LICENSE BLOCK 6# Version: CMPL 1.1 7# 8# The contents of this file are subject to the Cisco-style Mozilla Public 9# License Version 1.1 (the "License"); you may not use this file except 10# in compliance with the License. You may obtain a copy of the License 11# at www.eclipse-clp.org/license. 12# 13# Software distributed under the License is distributed on an "AS IS" 14# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 15# the License for the specific language governing rights and limitations 16# under the License. 17# 18# The Original Code is The ECLiPSe Constraint Logic Programming System. 19# The Initial Developer of the Original Code is Cisco Systems, Inc. 20# Portions created by the Initial Developer are 21# Copyright (C) 1999 - 2006 Cisco Systems, Inc. All Rights Reserved. 22# 23# Contributor(s): 24# 25# END LICENSE BLOCK 26# 27# ECLiPSe Development Environment 28# 29# 30# $Id: tkeclipse.tcl,v 1.17 2013/07/05 01:34:47 jschimpf Exp $ 31# 32 33#---------------------------------------------------------------------- 34# Find and load the eclipse package 35#---------------------------------------------------------------------- 36set tkecl(version) 6.2 ;# update also in eclipse_tools and examples! 37# including mapdebugdemo.tcl in <ECLiPSe>/document/tutorial/mapdebugdemo.tcl 38 39switch $tcl_platform(platform) { 40 unix { 41 set tkecl(ECLIPSEDIR) $env(ECLIPSEDIR) 42 } 43 windows { 44 package require registry 45 set tkecl(ECLIPSEDIR) [registry get \ 46 HKEY_LOCAL_MACHINE\\SOFTWARE\\IC-Parc\\Eclipse\\$tkecl(version) ECLIPSEDIR] 47 } 48 default { 49 error "$tcl_platform(platform) not supported" 50 exit 51 } 52} 53 54set tkecl(imagedir) [file join $tkecl(ECLIPSEDIR) lib_tcl Images] 55 56lappend auto_path [file join $tkecl(ECLIPSEDIR) lib_tcl] 57 58# Display a splash window (as soon as possible) 59 60wm title . "ECLiPSe $tkecl(version) Toplevel" 61wm iconname . ECLiPSe 62set tkecl(ec_image) [image create photo -format gif -file \ 63 [file join $tkecl(imagedir) eclipse_logo_blue75.gif]] 64set tkecl(ec_icon) [image create photo -format gif -file \ 65 [file join $tkecl(imagedir) eclipseclp32.gif]] 66pack [label .splash -image $tkecl(ec_image) -relief raised] -padx 5 -pady 5 67update 68 69 70 71switch $tcl_platform(platform) { 72 windows {wm iconbitmap . [file join $tkecl(imagedir) eclipseclp.ico]} 73 default {wm iconbitmap . @[file join $tkecl(imagedir) eclipseclp48.xbm]} 74} 75 76#toplevel .icon 77#pack [label .icon.l -image $tkecl(ec_icon)] 78#wm iconwindow . .icon 79#wm withdraw . 80#wm state . normal 81 82 83#---------------------------------------------------------------------- 84# Load packages and initialise global settings 85#---------------------------------------------------------------------- 86 87package require eclipse 88package require eclipse_tools 89package require AllWidgets 90 91set tkecl(ec_state) Initialising 92set tkecl(toplevel_in_command_exdr) "" 93set tkecl(delayed_gui_command) "" 94set tkecl(goal) {} 95set tkecl(stop_scrolling) 0 96set tkecl(history) {} 97set tkecl(historypos) -1 98set tkecl(nquery) 0 99set tkecl(localsize) 0 100set tkecl(globalsize) 0 101 102#---------------------------------------------------------------------- 103# Process command line options 104#---------------------------------------------------------------------- 105 106proc tkecl:usage {} { 107 puts stderr "Usage:" 108 puts stderr " -g <kbytes> global+trail stack size" 109 puts stderr " -l <kbytes> local+control stack size" 110} 111 112proc tkecl:get_stack_size {sizespec} { 113 # allow floats -- useful for sizes specified in gigabytes 114 if [regexp {^([0-9]+[.][0-9]+|[0-9]+)([^0-9]?)$} $sizespec whole size unit] { 115 116 switch $unit { 117 "" - 118 "k" - 119 "K" { 120 set multiple 1024 121 } 122 "m" - 123 "M" { 124 set multiple 1048576 ;# 1024*1024 125 } 126 "g" - 127 "G" { 128 set multiple 1073741824 ;# 1024*1024*1024 129 } 130 default { 131 # unknown unit 132 puts stderr "-$sizespec: invalid stack size specification" 133 return 0 134 } 135 } 136 # use 1.0 to force evaluation as floats (doubles) so that integer 137 # overflow can be detected 138 if [catch {expr round(1.0 * $multiple * $size)} result] { 139 puts stderr "-$sizespec: $result" 140 return 0 141 } 142 143 return $result 144 } else { 145 puts stderr "-$sizespec: invalid stack size specification" 146 return 0 ;# invalid sizespec 147 } 148} 149 150set argstate flag 151 152# we are assuming that if there are argv options, then this tkeclipse 153# was started from a command line, and so the puts will go to that window 154foreach arg $argv { 155 156 switch -- $argstate { 157 flag { 158 switch -exact -- $arg { 159 -l {set argstate local} 160 -g {set argstate global} 161 default {tkecl:usage} 162 } 163 } 164 local { 165 set tkecl(localsize) [tkecl:get_stack_size $arg] 166 set argstate flag 167 } 168 global { 169 set tkecl(globalsize) [tkecl:get_stack_size $arg] 170 set argstate flag 171 } 172 } 173} 174 175if {$argstate != "flag"} { tkecl:usage } ;# did not specify an argument 176unset argstate 177 178 179#---------------------------------------------------------------------- 180# GUI toplevel 181#---------------------------------------------------------------------- 182 183# Handler called when the toplevel query finishes 184proc tkecl:toplevel_out_handler {stream} { 185 tkecl:set_toplevel_state [ec_read_exdr [ec_streamnum_to_channel $stream]] 186} 187 188 189# Handler called when the toplevel waits for the next command 190proc tkecl:toplevel_in_handler {stream} { 191 global tkecl 192 193 if {$tkecl(delayed_gui_command) != ""} { 194 eval $tkecl(delayed_gui_command) 195 set tkecl(delayed_gui_command) "" 196 } 197 198 # All the GUI interaction happens during this tkwait! 199 tkwait variable tkecl(toplevel_in_command_exdr) 200 201 ec_queue_write toplevel_in $tkecl(toplevel_in_command_exdr) 202} 203 204 205# Update the global state variable tkecl(ec_state) 206# and configure the GUI accordingly 207 208proc tkecl:set_toplevel_state {state} { 209 global tkecl 210 211 if {$tkecl(ec_state) != $state} { 212 213 # state changed, update the gui 214 set tkecl(ec_state) $state 215 if {$state == "Running..."} { 216 set tkecl(oldcursor) [. cget -cursor] 217 . configure -cursor watch 218 .tkecl.query.buttons.run configure -state disabled 219 .tkecl.query.buttons.make configure -state disabled 220 .tkecl.query.buttons.more configure -state disabled 221 tkecl:activate_abort 222 tkecl:remove_current_highlights 223 if [winfo exists .ec_dg] { 224 .ec_dg.text tag remove highlight 1.0 end 225 } 226 } else { 227 # state is one of: More,Yes,No,Abort,Idle 228 if {$tkecl(pref,raise_when_done)} { 229 tkinspect:RaiseWindow . 230 } 231 # Select old query so it can be deleted more easily. 232 # Done after raising, because on Windows raising clears the selection 233 .tkecl.query.goal_entry selection range 0 end 234 if {$state == "More"} { 235 .tkecl.query.buttons.more configure -state normal 236 } else { 237 .tkecl.query.buttons.more configure -state disabled 238 } 239 . configure -cursor $tkecl(oldcursor) 240 .tkecl.query.buttons.run configure -state normal 241 .tkecl.query.buttons.make configure -state normal 242 tkecl:disable_abort 243 if [winfo exists .ec_dg] { 244 tkecl:refresh_dg 245 } 246 focus [.tkecl.query.goal_entry subwidget entry] 247 } 248 update 249 } 250} 251 252 253# run_mode is one of: call, profile, port_profile 254 255proc tkecl:run_goal {run_mode} { 256 global tkecl 257 258 # return if entry empty (avoids calling the goal 'end_of_file') 259 if [regexp -- {^[ ]*$} $tkecl(goal)] { 260 return 261 } 262 263 switch $tkecl(ec_state) { 264 No - 265 Abort - 266 Idle { 267 } 268 More - 269 Yes { 270 # Need to cut&fail the old goal first! To do this, we write an 271 # extra 'end' command to toplevel_in, but it will only be handled 272 # together with the next call-command (which is set up below). 273 ec_queue_write toplevel_in [ec_tcl2exdr end ()] 274 } 275 Initialising - 276 "Running..." { 277 return 278 } 279 } 280 tkecl:set_toplevel_state "Running..." 281 set tkecl(toplevel_in_command_exdr) [ec_tcl2exdr [list $run_mode $tkecl(goal)] (S)] 282 283 lappend tkecl(history) $tkecl(goal) 284 .tkecl.query.goal_entry add $tkecl(goal) 285 set tkecl(historypos) -1 286 if [winfo exists .ec_tools.history] { 287 .ec_tools.history.box insert 0 $tkecl(goal) 288 } 289} 290 291 292proc tkecl:more_goal {} { 293 global tkecl 294 295 if {$tkecl(ec_state) == "More"} { 296 tkecl:set_toplevel_state "Running..." 297 set tkecl(toplevel_in_command_exdr) [ec_tcl2exdr more ()] 298 } 299} 300 301 302#------------------------------------------------------------------------ 303# Wrapper around Tcl commands that should only be executed at 304# "toplevel", i.e. when there are no active queries 305#----------------------------------------------------------------------- 306proc tkecl:exec_toplevel_command {command} { 307 global tkecl 308 309 switch $tkecl(ec_state) { 310 More - 311 Yes { 312 ;# need to clean up any existing query before command 313 tkecl:set_toplevel_state Idle 314 set tkecl(toplevel_in_command_exdr) [ec_tcl2exdr end ()] 315 # execute command later in toplevel_in_handler 316 set tkecl(delayed_gui_command) $command 317 return 318 } 319 320 "Running..." { 321 ;# cannot execute command.... 322 bell 323 return 324 } 325 } 326 327 eval $command 328} 329 330 331#---------------------------------------------------------------------- 332# History 333#---------------------------------------------------------------------- 334 335proc tkecl:popup_history {} { 336 global tkecl 337 338 set history .ec_tools.history 339 if ![winfo exists $history] { 340 toplevel $history 341 listbox $history.box -width 40 -height 12 -yscrollcommand "$history.vscroll set" -font tkeclmono 342 scrollbar $history.vscroll -command "$history.box yview" 343 foreach goal $tkecl(history) { 344 $history.box insert 0 $goal 345 } 346 bind $history.box <Double-Button-1> { 347 set tkecl(goal) [selection get] 348 } 349 button $history.close -text Close -command "destroy $history" 350 label $history.label -text "Double-click to reuse old query" 351 pack $history.close -side bottom -fill x 352 pack $history.label -side bottom -fill x 353 pack $history.vscroll -side left -fill y 354 pack $history.box -side left -fill both -expand 1 355 tkecl:center_over $history . 356 } 357} 358 359proc tkecl:select_history {dir} { 360 global tkecl 361 362 set size [llength $tkecl(history)] 363 if {$tkecl(historypos) == -1} { 364 set tkecl(historypos) [expr $size - 1] 365 } 366 367 if [string match up $dir] { 368 ;# directions can only be up or down 369 if {$tkecl(historypos) > 0} { 370 incr tkecl(historypos) -1 371 set tkecl(goal) [lindex $tkecl(history) $tkecl(historypos)] 372 } else { 373 bell 374 } 375 } else { ;# move down 376 if {$tkecl(historypos) < $size} { 377 incr tkecl(historypos) 1 378 set tkecl(goal) [lindex $tkecl(history) $tkecl(historypos)] 379 } else { 380 bell 381 } 382 } 383} 384 385#---------------------------------------------------------------------- 386# Error notification 387#---------------------------------------------------------------------- 388 389proc tkecl:error_to_window {Window stream} { 390 global tkecl 391 392 set tkecl(stop_scrolling) 1 393 $Window see end 394 ;# make sure last error is always visible 395 tkecl:tkec_stream_to_window errorcolour $Window $tkecl(stop_scrolling) $stream 396} 397 398 399proc tkecl:CreateImage {name format} { 400 global tkecl 401 return [image create photo -format $format -file [file join $tkecl(ECLIPSEDIR) lib_tcl Images $name.$format]] 402} 403 404proc tkecl:Update_current_module {name dummy op} { 405 global tkecl 406 407 set result [ec_rpcq [list set_flag toplevel_module $tkecl(toplevel_module)] (()())] 408 if {$result == "throw"} { 409 ;# unsucessful module switch, change back to old module 410 set tkecl(toplevel_module) [lindex [ec_rpcq {get_flag toplevel_module _} (()_)] 2] 411 } 412} 413 414 415# center the child over the parent window 416# (adapted from the wm man page) 417proc tkecl:center_over {child parent} { 418 wm withdraw $child 419 update 420 set x [expr {max(0,[winfo x $parent]+([winfo width $parent]-[winfo width $child])/2)}] 421 set y [expr {max(0,[winfo y $parent]+([winfo height $parent]-[winfo height $child])/2)}] 422 wm geometry $child +$x+$y 423 wm transient $child $parent 424 wm deiconify $child 425} 426 427 428#---------------------------------------------------------------------- 429# About ECLiPSe 430#---------------------------------------------------------------------- 431 432proc tkecl:About {} { 433 global tkecl 434 global tcl_patchLevel 435 436 set w .tkecl.tkecl_about 437 438 if [winfo exists $w] {return} 439 foreach {name date} [lrange [ec_rpcq_check \ 440 {sepia_version_banner _ _} (__) sepia_kernel] 1 end] { 441 toplevel $w 442 wm title $w "About this Eclipse" 443 wm resizable $w 0 0 444 set t [frame $w.f] 445 pack [label $t.ec -image $tkecl(ec_image)] -side top 446 pack [label $t.n -text "$name (Tcl/Tk GUI using Tcl $tcl_patchLevel)"] -side top 447 pack $t -side top -padx 10 -pady 10 448 pack [button $w.ok -text OK -command "destroy $w"] \ 449 -ipady 10 -padx 10 -pady 10 -side bottom -fill x -expand 1 450 } 451 tkecl:center_over $w . 452} 453 454# taken and modified from cgi.tcl, by Don Libes 455# return string quoted appropriately to appear in a url 456proc cgi_quote_url {in} { 457 regsub -all {%} $in "%25" in 458 regsub -all {#} $in "%23" in 459 regsub -all { } $in "%20" in 460 regsub -all {"} $in "%22" in 461 regsub -all {;} $in "%3b" in 462 regsub -all {=} $in "%3d" in 463 regsub -all {\?} $in "%3f" in 464 return $in 465} 466 467proc tkecl:Documentation {} { 468 global tcl_platform env 469 set htmldoc [lindex [ec_rpcq {return_html_root _} (_) tracer_tcl] 1] 470 switch $tcl_platform(platform) { 471 windows { 472 # the $htmldoc file must have execute permission!! 473 set res [catch {exec $env(COMSPEC) /c $htmldoc &} msg] 474 } 475 476 default { 477 # try a couple of alternative browser launch commands 478 foreach cmd {xdg-open sensible-browser firefox opera google-chrome} { 479 set res [catch [list exec $cmd [cgi_quote_url $htmldoc] &] msg] 480 if {$res == 0} break 481 } 482 } 483 } 484 if $res { 485 tk_messageBox -type ok -icon error -message "Cannot launch browser: $msg" 486 } 487} 488 489 490#---------------------------------------------------------------------- 491# Selecting a query's output 492#---------------------------------------------------------------------- 493 494proc tkecl:Select_query_outputs {w other} { 495 set left [$w mark previous current] 496 set right [$w mark next current] 497 498 while {![regexp -- {^q[0-9]+$} $left]} { 499 if [string match "" $left] { 500 ;# got to left edge 501 set left 1.0 502 break 503 } 504 ;# repeat until a qN mark found 505 set left [$w mark previous $left] 506 } 507 508 while {![regexp -- {^q[0-9]+$} $right]} { 509 if [string match "" $right] { 510 ;# got to right edge 511 set right end 512 break 513 } 514 ;# repeat until a qN mark found 515 set right [$w mark next $right] 516 } 517 518 set notsame 1 519 foreach {oldl oldr} [$w tag ranges qsel] { 520 if {($oldl == [$w index $left] && $oldr == [$w index $right])} { 521 set notsame 0 522 } else { 523 set notsame 1 524 } 525 } 526 $w tag remove qsel 1.0 end 527 if {$notsame} { 528 $w tag add qsel $left $right 529 $w see "$right -1 lines" 530 } 531 532 $other tag remove qsel 1.0 end 533 if {$notsame} { 534 $other tag add qsel $left $right 535 $other see "$right -1 lines" 536 } 537 return 538} 539 540#triple click selects all earlier queries 541proc tkecl:Select_earlier_queries {w other} { 542 set right [$w mark next current] 543 544 while {![regexp -- {^q[0-9]+$} $right]} { 545 if [string match "" $right] { 546 ;# got to right edge 547 set right end 548 break 549 } 550 ;# repeat until a qN mark found 551 set right [$w mark next $right] 552 } 553 554 $w tag remove qsel 1.0 end 555 $w tag add qsel 1.0 $right 556 # no need to see right; should already be there because of double match 557 558 $other tag remove qsel 1.0 end 559 $other tag add qsel 1.0 $right 560 561 return 562} 563 564proc tkecl:toplevel_keypress {keysym} { 565# used to avoid inserting printing characters 566# (Control, Meta sequences should be allowed seperarely) 567 568 switch $keysym { 569 "Delete" - 570 "BackSpace" { ;# delete and backspace 571 foreach t {.tkecl.pane.stdio.tout .tkecl.pane.answer.tout} { 572 foreach {left right} [$t tag ranges qsel] { 573 $t delete $left $right 574 } 575 } 576 return -code break 577 } 578 "Home" - 579 "Prior" - 580 "Next" - 581 "Up" - 582 "Down" - 583 "Left" - 584 "Right" { ;# special one-key, default allowed 585 return 0 586 } 587 588 default { 589 return -code break 590 } 591 } 592} 593 594# pop up a menu called $y.popup over the text widget $t 595proc tkecl:output_popup {t X Y} { 596 if {[$t tag ranges sel] != ""} { 597 $t.popup entryconfigure "Copy*" -state normal 598 } else { 599 $t.popup entryconfigure "Copy*" -state disabled 600 } 601 tk_popup $t.popup $X $Y 602} 603 604 605# copy the selection of a text widget to the clipboard 606proc tkecl:copy_selection {t} { 607 if {[$t tag ranges sel] != ""} { 608 clipboard clear 609 clipboard append [$t get sel.first sel.last] 610 } 611} 612 613proc tkecl:entry_copy {t} { 614 if {[$t selection present]} { 615 clipboard clear 616 clipboard append [selection get] 617 } 618} 619 620proc tkecl:entry_paste {t} { 621 if {[$t selection present]} { 622 $t delete sel.first sel.last 623 } 624 $t insert insert [clipboard get] 625} 626 627#---------------------------------------------------------------------- 628# Make the existing outputs in stdio and answer windows non-current 629#---------------------------------------------------------------------- 630 631proc tkecl:remove_current_highlights {} { 632 global tkecl 633 634 .tkecl.pane.stdio.tout tag remove highlight 1.0 end 635 .tkecl.pane.stdio.tout tag remove errorcolour 1.0 end 636 .tkecl.pane.stdio.tout tag remove warning 1.0 end 637 .tkecl.pane.answer.tout tag remove highlight 1.0 end 638 .tkecl.pane.answer.tout tag remove errorcolour 1.0 end 639 .tkecl.pane.answer.tout tag remove successcolour 1.0 end 640 .tkecl.pane.stdio.tout mark set q$tkecl(nquery) "end -1 chars" 641 .tkecl.pane.stdio.tout mark gravity q$tkecl(nquery) left 642 .tkecl.pane.answer.tout mark set q$tkecl(nquery) "end -1 chars" 643 .tkecl.pane.answer.tout mark gravity q$tkecl(nquery) left 644 incr tkecl(nquery) 1 645 set tkecl(stop_scrolling) 0 646} 647 648#------------------------------------------------------------------------- 649# A more sohisticated queue_out_handler; used for error stream 650# added ScrollControl and TruncateLength 651#------------------------------------------------------------------------- 652proc tkecl:tkec_stream_to_window {Tag Window ScrollControl Stream} { 653 global tkecl 654 655 set channel [ec_streamnum_to_channel $Stream] 656 set data [read $channel 1000] 657 while {$data != ""} { 658 regexp {^([0-9]+)[.]([0-9]+)$} [$Window index end-1char] whole line charp 659 if {$charp < $tkecl(pref,text_truncate)} { 660 $Window insert end $data $Tag 661 } else { 662 ;# truncate printing of line if too long 663 if {[lsearch [$Window tag names] trunc] != -1} { 664 ;# not yet defined... 665 $Window tag configure trunc -background pink 666 } 667 if {[lsearch [$Window tag names end-2char] trunc] == -1} { 668 ;# line is first truncated. Note -2 needed (rather than -1) 669 $Window insert end "..." trunc 670 } 671 set nl [string first "\n" $data] 672 if {$nl != -1} { 673 ;# if there is a nl, then a new line was started 674 $Window insert end [string range $data $nl end] $Tag 675 } 676 } 677 set data [read $channel 1000] 678 } 679 680 if {!$ScrollControl || !$tkecl(stop_scrolling)} { 681 $Window see end 682 } 683} 684 685 686#------------------------------------------------------------------------ 687# creating + initialising modules 688#------------------------------------------------------------------------ 689 690proc tkecl:new_module_popup {} { 691 global tkecl 692 693 set w .tkecl.new_module_popup 694 if {![winfo exists $w]} { 695 set tkecl(new_module_name) "" 696 set tkecl(new_module_language) "eclipse_language" 697 toplevel $w 698 wm title $w "Create New Module" 699 label $w.ml -text "Module name:" -anchor w 700 entry $w.me -textvariable tkecl(new_module_name) -relief sunken -bg white 701 grid $w.ml $w.me -sticky news 702 label $w.ll -text "with language:" -anchor w 703 entry $w.le -textvariable tkecl(new_module_language) -relief sunken -bg white 704 grid $w.ll $w.le -sticky news 705 bind $w.me <Return> "tkecl:create_module $w" 706 bind $w.le <Return> "tkecl:create_module $w" 707 button $w.ok -text "OK" -command "tkecl:create_module $w" 708 button $w.cancel -text "Cancel" -command "destroy $w" 709 grid $w.ok $w.cancel -sticky news 710 grid columnconfigure $w 0 -weight 1 711 grid columnconfigure $w 1 -weight 1 712 grid rowconfigure $w 0 -weight 1 713 grid rowconfigure $w 1 -weight 1 714 grid rowconfigure $w 2 -weight 1 715 focus $w.me 716# balloonhelp $w.ml "Name of module to be created. Type <Ret> or click on OK to create module." 717# balloonhelp $w.ll "Name of language to be loaded with module. Type <Ret> or click on OK to create module." 718# balloonhelp $w.ok "Click to create specified module" 719# balloonhelp $w.cancel "Click to cancel without creating module" 720 721 tkecl:center_over $w . 722 723 } else { 724 tkinspect:RaiseWindow $w 725 } 726} 727 728proc tkecl:create_module {w} { 729 global tkecl 730 731 switch [ec_rpcq [list current_module $tkecl(new_module_name)] (())] { 732 throw { 733 tk_messageBox -type ok -icon error -message "Invalid module name: cannot create module $tkecl(new_module_name)" 734 return 735 } 736 fail {} 737 default { 738 switch [tk_messageBox -default yes -type yesno -icon question -message \ 739 "Module $tkecl(new_module_name) is an existing module. Do you want to try to reinitialise it?"] { 740 yes { 741 if {[ec_rpcq [list erase_module $tkecl(new_module_name)] (())] == "throw"} { 742 tk_messageBox -type ok -icon error -message "Unable to erase module" 743 return 744 } 745 } 746 no { return } 747 } 748 749 } 750 } 751 752 switch [ec_rpcq [list create_module $tkecl(new_module_name) {[]} $tkecl(new_module_language)] (()()())] { 753 fail - 754 throw { 755 ec_rpcq [list erase_module $tkecl(new_module_name)] (()) ;# clean up 756 tk_messageBox -type ok -icon error -message "Unable to create module $tkecl(new_module_name) with language $tkecl(new_module_language)" 757 } 758 default { 759 set tkecl(toplevel_module) $tkecl(new_module_name) 760 destroy $w 761 } 762 } 763 764} 765 766proc tkecl:init_toplev_module {} { 767 global tkecl 768 769 if {[tk_messageBox -default ok -type okcancel -icon warning -message "This will erase the current content of module '$tkecl(toplevel_module)'"] == "ok"} { 770 ec_rpcq init_toplevel_module () tracer_tcl 771 } 772} 773 774 775#------------------------------------------------------------------------ 776# default settings 777#------------------------------------------------------------------------ 778 779proc tkecl:set_toplevel_defaults {} { 780 global tkecl 781 782 783 lappend tkecl(preferences) \ 784 {globalsize "" +integer tkeclipserc "Global/trail stack size (in megabytes)"} \ 785 {localsize "" +integer tkeclipserc "Local/Control stack size (in megabytes)"} \ 786 {default_module "" string tkeclipserc "Default module name"} \ 787 {default_language "" string tkeclipserc "Default language"} \ 788 {initquery "" string tkeclipserc "Initial query called by TkECLiPSe on start-up"} \ 789 {raise_when_done 1 boolean tkeclipserc "Raise toplevel window when query finishes"} 790 791 set tkecl(pref,globalsize) "" 792 set tkecl(pref,localsize) "" 793 set tkecl(pref,initquery) "" 794 set tkecl(pref,default_module) "" 795 set tkecl(pref,default_language) "" 796 set tkecl(pref,raise_when_done) 1 797 798 set toplevdefaults [tkecl:get_user_defaults tkeclipserc] 799 800 foreach dname $toplevdefaults { 801 set dvalue $tkecl(prefset,$dname) 802 803 if {[string trimleft $dvalue] != ""} { 804 switch -exact -- $dname { 805 globalsize - 806 localsize { 807 # make sure it is an integer! 808 if [regexp {^[0-9]+$} $dvalue size] { 809 if {$tkecl($dname) == 0} { 810 # only set from pref value if not overridden 811 set tkecl($dname) [expr $dvalue * 1048576] ;# in megabytes 812 } 813 set tkecl(pref,$dname) $dvalue 814 } else { 815 tk_messageBox -icon warning -message "$dname parameter: $dvalue should be a number" -type ok 816 } 817 } 818 default_language - 819 default_module { 820 set tkecl(pref,$dname) $dvalue 821 ec_set_option $dname $dvalue 822 } 823 824 default {set tkecl(pref,$dname) $dvalue } 825 } 826 } 827 } 828 829} 830 831proc tkecl:set_stack_sizes {} { 832 global tkecl 833 834 foreach stack "globalsize localsize" { 835 if {$tkecl($stack) != 0} { 836 ec_set_option $stack $tkecl($stack) 837 unset tkecl($stack) ;# no longer needed 838 } 839 } 840} 841 842#---------------------------------------------------------------------- 843# Start of toplevel initialisation code 844#---------------------------------------------------------------------- 845lappend tkecl(helpfiles) topl "TkECLiPSe Toplevel" toplevelhelp.txt 846tkecl:set_tkecl_tkdefaults tkecl 847frame .tkecl 848tkecl:set_toplevel_defaults 849tkecl:set_stack_sizes 850 851#---------------------------------------------------------------------- 852# Make the toplevel window 853#---------------------------------------------------------------------- 854 855menu .tkecl.mbar 856. config -menu .tkecl.mbar 857.tkecl.mbar add cascade -label "File" -menu .tkecl.mbar.file -underline 0 858menu .tkecl.mbar.file 859.tkecl.mbar.file add command -label "Change directory ..." -command {tkecl:remove_current_highlights; tkecl:get_newcwd} 860.tkecl.mbar.file add command -label "Compile ..." -command {tkecl:exec_toplevel_command {tkecl:remove_current_highlights; tkecl:compile_popup [pwd]}} 861.tkecl.mbar.file add command -label "Use module ..." -command {tkecl:exec_toplevel_command {tkecl:remove_current_highlights; tkecl:use_module_popup}} 862.tkecl.mbar.file add command -label "Edit ..." -command tkecl:edit_popup 863.tkecl.mbar.file add command -label "Edit new ..." -command tkecl:edit_new_popup 864.tkecl.mbar.file add command -label "Cross referencer ..." -command {tkecl:exec_toplevel_command tkecl:xref_popup} 865.tkecl.mbar.file add command -label "Source checker (lint) ..." -command {tkecl:exec_toplevel_command tkecl:lint_popup} 866.tkecl.mbar.file add separator 867#.tkecl.mbar.file add command -label "Change to example directory" -command { 868# tkecl:newcwd [file join $tkecl(ECLIPSEDIR) doc examples] 869# tk_messageBox -type ok -message "Changed directory to $tkecl(cwd)" 870# } 871.tkecl.mbar.file add command -label "Compile example ..." -command {tkecl:exec_toplevel_command {tkecl:remove_current_highlights; tkecl:compile_popup\ 872 [file join $tkecl(ECLIPSEDIR) doc examples]}} 873.tkecl.mbar.file add separator 874.tkecl.mbar.file add command -label "New module ..." -command {tkecl:exec_toplevel_command tkecl:new_module_popup} 875.tkecl.mbar.file add command -label "Clear toplevel module" -command {tkecl:exec_toplevel_command tkecl:init_toplev_module} 876.tkecl.mbar.file add separator 877.tkecl.mbar.file add command -label Exit -command {destroy .} 878 879.tkecl.mbar add cascade -label "Query" -underline 0 -menu .tkecl.mbar.run 880menu .tkecl.mbar.run 881.tkecl.mbar.run add command -label "Run" -command {tkecl:run_goal call} 882.tkecl.mbar.run add command -label "Time Profile" -command {tkecl:run_goal profile} 883.tkecl.mbar.run add command -label "Port Profile" -command {tkecl:run_goal port_profile} 884.tkecl.mbar.run add separator 885.tkecl.mbar.run add command -label "History" -command {tkecl:popup_history} 886switch $tcl_platform(platform) { 887 # currently not supported on Windows 888 windows { .tkecl.mbar.run entryconfigure "Time Profile" -state disabled } 889} 890 891.tkecl.mbar add cascade -label "Tools" -underline 0 -menu .tkecl.mbar.windows 892 893.tkecl.mbar add cascade -label "Help" -menu .tkecl.mbar.help -underline 0 894menu .tkecl.mbar.help 895.tkecl.mbar.help add command -label "About this ECLiPSe ..." -command tkecl:About 896.tkecl.mbar.help add command -label "Full Documentation ..." -command tkecl:Documentation 897.tkecl.mbar.help add separator 898.tkecl.mbar.help add check -label "Balloon Help" -variable tkecl(pref,balloonhelp) 899.tkecl.mbar.help add separator 900 901#---------------------------------------------------------------------- 902frame .tkecl.query -relief groove -bd 3 903#---------------------------------------------------------------------- 904label .tkecl.query.label -text "Query Entry" 905#label .tkecl.query.module -textvariable tkecl(toplevel_module) 906combobox .tkecl.query.module -click single -listheight 6 -width 10 -editable 0 \ 907 -postcommand {tkecl:combo_add_modules .tkecl.query.module} \ 908 -textvariable tkecl(toplevel_module) 909label .tkecl.query.colon -text ":" 910 911trace variable tkecl(toplevel_module) w tkecl:Update_current_module 912frame .tkecl.query.buttons 913button .tkecl.query.buttons.make -text "make" -command \ 914 {tkecl:exec_toplevel_command {tkecl:remove_current_highlights; \ 915 ec_rpcq make () ;\ 916 ec_rpcq {flush output} (()) ;\ 917 ec_rpcq {flush error} (()) ;\ 918 ec_rpcq {flush warning_output} (()) }} 919button .tkecl.query.buttons.run -text "run" -command {tkecl:run_goal call} 920button .tkecl.query.buttons.more -text "more" -command tkecl:more_goal 921 922frame .tkecl.query.buttons.abort 923 924#entry .tkecl.query.goal_entry -bg white -width 80 -textvariable tkecl(goal) 925 926option add *tkecl.query.goal_entry*Listbox.font tkeclmono 927combobox .tkecl.query.goal_entry -click single -listheight 6 -bg white -width 65 \ 928 -textvariable tkecl(goal) -takefocus 1 929 930set entry .tkecl.query.goal_entry 931menu $entry.popup -tearoff 0 932$entry.popup add command -label "Copy" -command "tkecl:entry_copy $entry" 933$entry.popup add command -label "Paste" -command "tkecl:entry_paste $entry" 934$entry.popup add separator 935$entry.popup add command -label "History" -command "tkecl:popup_history" 936 937bind .tkecl.query.goal_entry <Return> {tkecl:run_goal call} 938bind .tkecl.query.goal_entry <Button-3> {tk_popup $entry.popup %X %Y} 939bind .tkecl.query.goal_entry <Control-Button-1> {tk_popup $entry.popup %X %Y} 940bind .tkecl.query.goal_entry <Key-Up> {tkecl:select_history up} 941bind .tkecl.query.goal_entry <Key-Down> {tkecl:select_history down} 942 943label .tkecl.query.buttons.status -bg white -relief sunken -width 20 -textvariable tkecl(ec_state) 944 945#---------------------------------------------------------------------- 946# Answer binding window and output/error window 947# they are together in a frame and managed by the pane-manager 948#---------------------------------------------------------------------- 949frame .tkecl.pane -height 12c 950 951frame .tkecl.pane.answer -relief groove -bd 3 952scrollbar .tkecl.pane.answer.vscroll -command ".tkecl.pane.answer.tout yview" 953scrollbar .tkecl.pane.answer.hscroll -command ".tkecl.pane.answer.tout xview" -orient horizontal 954#text .tkecl.pane.answer.tout -bg white -height 15 -yscrollcommand ".tkecl.pane.answer.vscroll set" -wrap none -xscrollcommand ".tkecl.pane.answer.hscroll set" 955text .tkecl.pane.answer.tout -bg white -width 80 -yscrollcommand ".tkecl.pane.answer.vscroll set" -wrap none -xscrollcommand ".tkecl.pane.answer.hscroll set" 956label .tkecl.pane.answer.label -text "Results" 957.tkecl.pane.answer.tout tag configure highlight -foreground blue 958.tkecl.pane.answer.tout tag configure errorcolour -foreground red 959.tkecl.pane.answer.tout tag configure successcolour -foreground #00b000 960.tkecl.pane.answer.tout tag configure qsel -background lightblue 961menu .tkecl.pane.answer.tout.popup -tearoff 0 962.tkecl.pane.answer.tout.popup add command -label "Copy selection to clipboard" -command "tkecl:copy_selection .tkecl.pane.answer.tout" 963.tkecl.pane.answer.tout.popup add command -label "Highlight corresponding output" -command "tkecl:Select_query_outputs .tkecl.pane.answer.tout .tkecl.pane.stdio.tout" 964.tkecl.pane.answer.tout.popup add command -label "Clear this window" -command ".tkecl.pane.answer.tout delete 1.0 end" 965bind .tkecl.pane.answer.tout <Any-Key> "tkecl:toplevel_keypress %K" 966bind .tkecl.pane.answer.tout <Control-Key> "continue" 967bind .tkecl.pane.answer.tout <Meta-Key> "continue" 968# allow ^C to work as copy in window 969bind .tkecl.pane.answer.tout <ButtonRelease-2> {break} 970bind .tkecl.pane.answer.tout <Button-3> {tkecl:output_popup .tkecl.pane.answer.tout %X %Y} 971bind .tkecl.pane.answer.tout <Control-Button-1> \ 972 {tkecl:output_popup .tkecl.pane.answer.tout %X %Y} 973#bind .tkecl.pane.answer.tout <Double-Button-3> "tkecl:Select_query_outputs .tkecl.pane.answer.tout .tkecl.pane.stdio.tout" 974#bind .tkecl.pane.answer.tout <Triple-Button-3> "tkecl:Select_earlier_queries .tkecl.pane.answer.tout .tkecl.pane.stdio.tout" 975 976#pack .tkecl.pane.answer.vscroll -side left -fill y 977#pack .tkecl.pane.answer.label -side top -fill x 978#pack .tkecl.pane.answer.hscroll -side bottom -fill x 979#pack .tkecl.pane.answer.tout -side bottom -expand 1 -fill both 980 981pack .tkecl.pane.answer.label -side top -fill x 982pack .tkecl.pane.answer.vscroll -side left -fill y 983pack .tkecl.pane.answer.hscroll -side bottom -fill x 984pack .tkecl.pane.answer.tout -expand 1 -fill both 985 986 987frame .tkecl.pane.stdio -relief groove -bd 3 988scrollbar .tkecl.pane.stdio.vscroll -command ".tkecl.pane.stdio.tout yview" 989scrollbar .tkecl.pane.stdio.hscroll -command ".tkecl.pane.stdio.tout xview" -orient horizontal 990text .tkecl.pane.stdio.tout -width 80 -bg white -height 15 -yscrollcommand ".tkecl.pane.stdio.vscroll set" -wrap none -xscrollcommand ".tkecl.pane.stdio.hscroll set" 991.tkecl.pane.stdio.tout tag configure highlight -foreground blue 992.tkecl.pane.stdio.tout tag configure warning -foreground orange 993.tkecl.pane.stdio.tout tag configure errorcolour -foreground red 994.tkecl.pane.stdio.tout tag configure nohandlercolour -foreground green 995.tkecl.pane.stdio.tout tag configure qsel -background lightblue 996label .tkecl.pane.stdio.label -text "Output and Error Messages" 997menu .tkecl.pane.stdio.tout.popup -tearoff 0 998.tkecl.pane.stdio.tout.popup add command -label "Copy selection to clipboard" -command "tkecl:copy_selection .tkecl.pane.stdio.tout" 999.tkecl.pane.stdio.tout.popup add command -label "Highlight corresponding query" -command "tkecl:Select_query_outputs .tkecl.pane.stdio.tout .tkecl.pane.answer.tout" 1000.tkecl.pane.stdio.tout.popup add command -label "Clear this window" -command ".tkecl.pane.stdio.tout delete 1.0 end" 1001 1002pack .tkecl.pane.stdio.label -side top -fill x 1003pack .tkecl.pane.stdio.vscroll -side left -fill y 1004pack .tkecl.pane.stdio.hscroll -side bottom -fill x 1005pack .tkecl.pane.stdio.tout -expand 1 -fill both 1006bind .tkecl.pane.stdio.tout <Any-Key> "tkecl:toplevel_keypress %K" 1007bind .tkecl.pane.stdio.tout <Control-Key> "continue" 1008bind .tkecl.pane.stdio.tout <Meta-Key> "continue" 1009bind .tkecl.pane.stdio.tout <ButtonRelease-2> {break} 1010bind .tkecl.pane.stdio.tout <Button-3> {tkecl:output_popup .tkecl.pane.stdio.tout %X %Y} 1011bind .tkecl.pane.stdio.tout <Control-Button-1> \ 1012 {tkecl:output_popup .tkecl.pane.stdio.tout %X %Y} 1013#bind .tkecl.pane.stdio.tout <Double-Button-3> "tkecl:Select_query_outputs .tkecl.pane.stdio.tout .tkecl.pane.answer.tout" 1014#bind .tkecl.pane.stdio.tout <Triple-Button-3> "tkecl:Select_earlier_queries .tkecl.pane.stdio.tout .tkecl.pane.answer.tout" 1015bind .tkecl.pane.stdio.vscroll <ButtonRelease-1> "set tkecl(stop_scrolling) 0" 1016 1017pane .tkecl.pane.answer .tkecl.pane.stdio -orient vertical -initfrac [list 0.35 0.65] 1018 1019 1020#---------------------------------------------------------------------- 1021# Pack the toplevel window 1022#---------------------------------------------------------------------- 1023 1024pack .tkecl.query -side top -fill x 1025pack .tkecl.pane -side top -fill both -expand 1 1026 1027pack .tkecl.query.buttons.run .tkecl.query.buttons.more -side left -expand 1 -fill x 1028pack .tkecl.query.buttons.status -side left -fill y 1029pack .tkecl.query.buttons.make -side left -expand 1 -fill x 1030pack .tkecl.query.buttons.abort -side left -expand 1 -fill x 1031pack .tkecl.query.label -side top -fill x -expand 1 1032pack .tkecl.query.buttons -side bottom -fill x -expand 1 1033pack .tkecl.query.module -side left 1034pack .tkecl.query.colon -side left 1035pack .tkecl.query.goal_entry -side left -expand 1 -fill x 1036focus [.tkecl.query.goal_entry subwidget entry] 1037 1038 1039#---------------------------------------------------------------------- 1040# The abort button 1041# 1042# On Unix, the abort button is implemented using a separate process 1043# in order to allow aborts while eclipse is running; with X11, 1044# this process is placed in the TkECLiPSe window using a container, 1045# which is started only after the TkECLiPSe window is displayed. 1046# Aqua does not allow the container mechanism, so the button is implemented 1047# as an independent window. In both cases, the abort button and TkECLiPSe 1048# are coordinated via a socket connection. 1049#---------------------------------------------------------------------- 1050 1051switch $tcl_platform(platform) { 1052 unix { 1053 1054 proc tkecl:abort_button_connect {} { 1055 global tkecl 1056 # start from a high port number (1024-5000 apparently often 1057 # used by OS's client programs) and work upwards until a free port 1058 set port 5001 1059 while {[catch "socket -server tkecl:abort_button_accepted $port" tkecl(abort,server)]} { 1060 incr port 1 1061 } 1062 return $port 1063 } 1064 1065 proc tkecl:abort_button_accepted {abort_channel addr port} { 1066 global tkecl 1067 set tkecl(abort,channel) $abort_channel 1068 fileevent $abort_channel readable "tkecl:from_abort_button $abort_channel" 1069 catch {close $tkecl(abort,server)} 1070 } 1071 1072 proc tkecl:from_abort_button {abort_channel} { 1073 ;# process output from tkabortbutton; currently only eof 1074 if [eof $abort_channel] { 1075 ;# eof if tkabortbutton was killed, recreate it 1076 catch {close $abort_channel} 1077 1078 ;# catch for case when ThECLiPSe was destroyed 1079 catch { tkecl:create_abort_button } 1080 return 1081 } 1082 gets $abort_channel line 1083 } 1084 1085 proc tkecl:create_abort_button {} { 1086 global tkecl 1087 1088 set port [tkecl:abort_button_connect] 1089 switch [ec_tk_platform] { 1090 unix_aqua { 1091 exec [info nameofexecutable] \ 1092 [file join $tkecl(ECLIPSEDIR) lib_tcl tkabortbutton] \ 1093 [pid] standalone $port & 1094 } 1095 unix_x11 { 1096 exec [info nameofexecutable] \ 1097 [file join $tkecl(ECLIPSEDIR) lib_tcl tkabortbutton] \ 1098 -use [winfo id .tkecl.query.buttons.abort.abort_frame] \ 1099 [pid] embedded $port & 1100 } 1101 } 1102 1103 vwait tkecl(abort,channel) 1104 tkecl:disable_abort 1105 } 1106 1107 proc tkecl:disable_abort {} { 1108 global tkecl 1109 puts $tkecl(abort,channel) disable 1110 flush $tkecl(abort,channel) 1111 } 1112 1113 proc tkecl:activate_abort {} { 1114 global tkecl 1115 puts $tkecl(abort,channel) activate 1116 flush $tkecl(abort,channel) 1117 } 1118 1119 switch [ec_tk_platform] { 1120 unix_x11 { 1121 frame .tkecl.query.buttons.abort.abort_frame -container true 1122 pack .tkecl.query.buttons.abort.abort_frame -expand 1 -fill both 1123 } 1124 unix_aqua { 1125 pack forget .tkecl.query.buttons.abort 1126 tkecl:create_abort_button 1127 } 1128 } 1129 } 1130 1131 windows { 1132 if {[ec_interface_type] == "remote"} { 1133 button .tkecl.query.buttons.abort.abort_button -text interrupt \ 1134 -command "ec_write_exdr [ec_streamname_to_channel gui_pause_request] int ()" 1135 } else { 1136 button .tkecl.query.buttons.abort.abort_button -text interrupt \ 1137 -command "ec_post_event int" 1138 } 1139 pack .tkecl.query.buttons.abort.abort_button -expand 1 -fill both 1140 1141 proc tkecl:disable_abort {} { 1142 .tkecl.query.buttons.abort.abort_button configure -state disabled 1143 } 1144 proc tkecl:activate_abort {} { 1145 .tkecl.query.buttons.abort.abort_button configure -state normal 1146 } 1147 } 1148} 1149 1150 1151proc tkecl:stop_request_handler {stream} { 1152 global tkecl 1153 set event [ec_read_exdr [ec_streamnum_to_channel $stream]] 1154 if ![winfo exists .tkecl.ec_stop_continue_box] { 1155 # We don't use a tk_messageBox or tk_dialog because they are modal. 1156 toplevel .tkecl.ec_stop_continue_box 1157 wm title .tkecl.ec_stop_continue_box "ECLiPSe interrupt" 1158 label .tkecl.ec_stop_continue_box.msg -relief raised -height 3 -width 50 \ 1159 -text "Execution interrupted - do you want to abort?" 1160 button .tkecl.ec_stop_continue_box.abort -text "Yes, abort" \ 1161 -command {set tkecl(stop_continue) abort; destroy .tkecl.ec_stop_continue_box} 1162 button .tkecl.ec_stop_continue_box.cont -text "No, continue" \ 1163 -command {set tkecl(stop_continue) cont; destroy .tkecl.ec_stop_continue_box} 1164 button .tkecl.ec_stop_continue_box.creep -text "Continue in creep mode" \ 1165 -command {set tkecl(stop_continue) creep; destroy .tkecl.ec_stop_continue_box} 1166 pack .tkecl.ec_stop_continue_box.msg -side top -fill both -expand 1 1167 pack .tkecl.ec_stop_continue_box.abort -side left -expand 1 -pady 3m -padx 3m 1168 pack .tkecl.ec_stop_continue_box.cont -side left -expand 1 -pady 3m -padx 3m 1169 pack .tkecl.ec_stop_continue_box.creep -side left -expand 1 -pady 3m -padx 3m 1170 1171 switch [lindex [ec_rpcq {get_flag debugging _} (()_)] 2] { 1172 nodebug { .tkecl.ec_stop_continue_box.creep configure -state disabled } 1173 } 1174 1175 tkwait variable tkecl(stop_continue) 1176 switch $tkecl(stop_continue) { 1177 abort { 1178 if {[ec_interface_type] == "remote"} { 1179 ec_write_exdr [ec_streamname_to_channel gui_pause_request] abort () 1180 } else { 1181 ec_post_event abort 1182 } 1183 } 1184 creep { 1185 ec_rpcq {trace_mode 0 0} (II) sepia_kernel 1186 } 1187 } 1188 } 1189} 1190 1191#---------------------------------------------------------------------- 1192# Balloon Help 1193#---------------------------------------------------------------------- 1194 1195balloonhelp .tkecl.query.label "Query entry - type query in here (terminating `.' optional). <Ret> or run to execute.\n Up and down arrows moves through previous queries, <Tab> for query completion.\n Left-click arrow on right-hand side for selecting previous queries (non-duplicated).\n Right-click (or control-left) for copy, paste and history." 1196balloonhelp .tkecl.query.buttons.status "Status of last query" 1197balloonhelp .tkecl.query.buttons.more "Try to find more solutions" 1198balloonhelp .tkecl.query.buttons.run "Start query execution" 1199balloonhelp .tkecl.query.buttons.make "Recompile files that have been modified" 1200balloonhelp .tkecl.query.buttons.abort "Interrupt executing query" 1201balloonhelp .tkecl.query.module "Module in which the query will be executed" 1202balloonhelp .tkecl.pane.answer.label "Results display - top-level bindings and status after execution.\n Results for the most recent query are in blue.\n\ 1203Right (or control-left) to popup a menu to copy selection to clipboard, match a query's outputs, or clear the window." 1204balloonhelp .tkecl.pane.stdio.label "Output and Error Message display.\n Most recent outputs are in blue, error messages are in red, warnings in orange.\n\ 1205Scrolling is disabled by warning and error messages. Left-click on scrollbar to re-enable scrolling.\n\ 1206Right (or control-left) click to popup a menu to copy selection to clipboard, match a query's outputs, or clear the window." 1207balloonhelp .tkecl.pane.__h1 "Press and drag left mouse to adjust Results and Output window sizes" 1208# bind . <Alt-h> "tkecl:Get_helpfileinfo topl {}" get help menu 1209 1210#---------------------------------------------------------------------- 1211# Initialise and start eclipse toplevel 1212#---------------------------------------------------------------------- 1213 1214#ec_set_option io 0 1215 1216ec_init 1217bind .tkecl.query.label <Destroy> { 1218 set tkecl(toplevel_in_command_exdr) [ec_tcl2exdr exit ()] 1219 } 1220 1221pack forget .splash 1222destroy .splash 1223pack .tkecl -expand true -fill both 1224 1225# The exec is started only after .tkecl is packed. Otherwise tkabortbutton 1226# might be executed before there is a window and this leads to an error 1227if {[ec_tk_platform] == "unix_x11"} { 1228 tkecl:create_abort_button 1229} 1230 1231ec_tools_init .tkecl.mbar.windows 1232 1233foreach {key topic filename} $tkecl(helpfiles) { 1234 .tkecl.mbar.help add command -label $topic -command "tkecl:Get_helpfileinfo $key {}" 1235} 1236 1237# use the more sophisticated version of ec_stream_to_window for more control 1238ec_queue_create output r {tkecl:tkec_stream_to_window highlight .tkecl.pane.stdio.tout 1} 1239ec_queue_create error r "tkecl:error_to_window .tkecl.pane.stdio.tout" 1240ec_rpcq {set_stream user_output output} (()()) 1241ec_rpcq {set_stream user_error error} (()()) 1242 1243# ensure_loaded rather than use_module: we don't want to import 1244ec_rpcq {ensure_loaded {library toplevel}} ((())) 1245ec_rpcq {toplevel_init gui} (()) toplevel 1246 1247ec_queue_create gui_interrupt_request r tkecl:stop_request_handler 1248ec_queue_create answer_output r "ec_stream_to_window highlight .tkecl.pane.answer.tout" 1249ec_queue_create warning_output r "tkecl:tkec_stream_to_window warning .tkecl.pane.stdio.tout $tkecl(stop_scrolling)" 1250ec_queue_create toplevel_out r tkecl:toplevel_out_handler 1251ec_queue_create toplevel_in w tkecl:toplevel_in_handler 1252ec_rpcq {set_stream_property warning_output flush end_of_line} (()()()) 1253 1254if {![string match $tkecl(version) [lindex [ec_rpcq_check {get_flag version _} (()_)] 2]]} { 1255 tk_messageBox -icon warning -message "Version differences detected between Tcl and ECLiPSe codes" -type ok 1256} 1257 1258if {[string trimleft $tkecl(pref,initquery)] != ""} { 1259 ec_rpc_check $tkecl(pref,initquery) S 1260} 1261 1262set tkecl(oldcursor) [. cget -cursor] 1263 1264if {[ec_interface_type] == "remote"} { 1265 ec_rpcq toplevel () toplevel 1266} else { 1267 ec_post_goal {: toplevel toplevel} (()()) 1268 ec_resume 1 ;# resume async to keep the GUI active 1269} 1270ec_cleanup 1271