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