1# BEGIN LICENSE BLOCK 2# Version: CMPL 1.1 3# 4# The contents of this file are subject to the Cisco-style Mozilla Public 5# License Version 1.1 (the "License"); you may not use this file except 6# in compliance with the License. You may obtain a copy of the License 7# at www.eclipse-clp.org/license. 8# 9# Software distributed under the License is distributed on an "AS IS" 10# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11# the License for the specific language governing rights and limitations 12# under the License. 13# 14# The Original Code is The ECLiPSe Constraint Logic Programming System. 15# The Initial Developer of the Original Code is Cisco Systems, Inc. 16# Portions created by the Initial Developer are 17# Copyright (C) 2006 Cisco Systems, Inc. All Rights Reserved. 18# 19# Contributor(s): Kish Shen, IC-Parc 20# 21# END LICENSE BLOCK 22 23# 24# $Id: tktools.tcl,v 1.5 2013/07/05 01:34:47 jschimpf Exp $ 25# 26# This file is the front end for the remote development tools 27# 28# Author: Kish Shen 11 Aug 2000 29# 30# Do NOT include any development support here! 31# Do NOT assume the existence of an interactive ECLiPSe toplevel! 32# 33# 34#---------------------------------------------------------------------- 35# Find and load the eclipse package 36#---------------------------------------------------------------------- 37set tkecl(version) 6.2 ;# update also in eclipse_tools and examples! 38 39lappend tkecl(helpfiles) tktools "Remote TkTools" tktoolshelp.txt 40 41switch $tcl_platform(platform) { 42 unix { 43 set tkecl(ECLIPSEDIR) $env(ECLIPSEDIR) 44 } 45 windows { 46 package require registry 47 set tkecl(ECLIPSEDIR) [registry get \ 48 HKEY_LOCAL_MACHINE\\SOFTWARE\\IC-Parc\\Eclipse\\$tkecl(version) ECLIPSEDIR] 49 } 50 default { 51 error "$tcl_platform(platform) not supported" 52 exit 53 } 54} 55 56lappend auto_path [file join $tkecl(ECLIPSEDIR) lib_tcl] 57 58package require eclipse_tools 59package require AllWidgets 60package require remote_eclipse 61 62proc tkecl:freeze_control {} { 63 global tkecl 64 65 if {[ec_multi:get_multi_status] == "off"} { 66 .f.cont configure -state disabled 67 .f.status configure -text "ECLiPSe Active" -fg darkgray -bg lightgray 68 while {1} { 69 ;# this is needed to avoid problems when something else has grab - 70 ;# e.g. if a menu is being pulled down from window by user 71 if [catch {grab .f}] { 72 continue 73 } else {break} 74 } 75 } 76 77} 78 79proc tkecl:thaw_control {} { 80 if {[ec_multi:get_multi_status] == "off"} { 81 .f.status configure -text "TkTools Active" -fg #00b000 -bg beige 82 grab release .f 83 } 84} 85 86proc ecyield_control {} { 87 if {[ec_multi:get_multi_status] == "off"} { 88 update idletasks ;# get rid of any events on the disabled button 89 .f.cont configure -state normal 90 } 91} 92 93proc ec_continue {} { 94 update 95 ec_resume resume 96} 97 98proc detach_tools {} { 99 100 if {![ec_running]} { 101 ec_disconnect tcl 102 disconnect_control 103 } 104} 105 106proc disconnect_control {} { 107 108 if [winfo exists .f] { 109 .f.cont configure -state disabled 110 .f.cont configure -text "Disconnected" 111 } 112} 113 114proc quit_tools {} { 115 116 detach_tools ;# will do nothing if already detached 117 destroy . 118} 119 120#------------------------------------------------------------------- 121# Attach 122#------------------------------------------------------------------- 123 124proc attach_tools {} { 125 global tk_tools 126 127 if {($tk_tools(host) != "" && $tk_tools(port) != "")} { 128 if [catch {ec_remote_init $tk_tools(host) $tk_tools(port) "ec_tools_init .mbar.tools"} err] { 129 # exit with error as the initialisation failed (which can then 130 # be caugth if tktools is run using exec) 131 puts stderr $err 132 exit -1 133 } 134 destroy .e 135 } 136} 137 138set argstate flag 139set tk_tools(host) [info hostname] 140set tk_tools(port) "" 141 142 143. config -menu .mbar 144menu .mbar 145.mbar add cascade -label File -menu .mbar.file 146.mbar add cascade -label Tools -menu .mbar.tools 147 menu .mbar.file 148 .mbar.file add command -label Disconnect -command detach_tools 149 .mbar.file add command -label Exit -command quit_tools 150pack [frame .f] -expand 1 -fill both 151pack [label .f.status -width 25 -borderwidth 3 -relief ridge] -expand 1 -fill x -side top 152pack [button .f.cont -text "Resume ECLiPSe" -command ec_continue -relief groove -borderwidth 5] -expand 1 -fill both -padx 10 -pady 10 153bind .f.cont <Destroy> "ec_disconnect tcl" 154 155foreach arg $argv { 156 switch -- $argstate { 157 flag { 158 switch -exact -- $arg { 159 -h {set argstate host} 160 -p {set argstate port} 161 default {puts stderr "Unknown flag $arg"; exit -1} 162 } 163 } 164 host { 165 set tk_tools(host) $arg 166 set argstate flag 167 } 168 port { 169 set tk_tools(port) $arg 170 set argstate flag 171 } 172 } 173} 174 175if {$argstate != "flag"} { 176 puts stderr "No argument supplied with option $arg" 177 exit -1 178} 179 180if {$tk_tools(port) == ""} { 181 182 ;# popup a window to ask for host and port... 183 toplevel .e 184 wm title .e "Connecting tktools to..." 185 pack [message .e.ins -justify center -aspect 350 -padx 10 -pady 10 -relief ridge -borderwidth 2 -text \ 186 "Specify hostname and port number of ECLiPSe session to connect \ 187 to (Use attach_tools/0 from lib(remote_tools) in ECLiPSe session)."] \ 188 -expand true -fill both 189 pack [frame .e.host] -expand true -fill both 190 pack [label .e.host.l -text "Host:"] -side left 191 pack [entry .e.host.e -textvariable tk_tools(host) -relief sunken] -side right 192 pack [frame .e.port] -expand true -fill both 193 pack [label .e.port.l -text "Port:"] -side left 194 pack [ventry .e.port.e -textvariable tk_tools(port) -relief sunken \ 195 -vcmd {regexp {^[0-9]*$} %P} -validate key -invalidcmd bell ] -side right 196 pack [button .e.ok -text "OK" -command attach_tools] -expand true -fill both -side bottom 197 198 wm title . "Detached Development Tools" 199 200 bind .e.port.e <Return> attach_tools 201 bind .e.port.e <Destroy> {if {![ec_connected]} exit} 202 203 wm withdraw . 204 tkwait window .e 205 wm deiconify . 206} else { 207 208 ;# host and port already specified... 209 attach_tools 210} 211 212ec_running_set_commands tkecl:freeze_control tkecl:thaw_control ecyield_control disconnect_control 213 214 215 216.mbar add cascade -label "Help" -menu .mbar.help -underline 0 217menu .mbar.help 218 .mbar.help add check -label "Balloon Help" -variable tkecl(pref,balloonhelp) 219 .mbar.help add separator 220 221foreach {key topic filename} $tkecl(helpfiles) { 222 .mbar.help add command -label $topic -command "tkecl:Get_helpfileinfo $key {}" 223} 224 225update 226 227ec_resume resume 228 229 230