Context Navigation

svxedit.in @ 7bb8184

Visit:

Last change on this file since 7bb8184 was 7bb8184, checked in by Olly Betts <olly@…>, 13 years ago

Retagging 1.2.0

git-svn-id: file:///home/survex-svn/survex/tags/1.2.0@3664 4b37db11-9a0c-4f06-9ece-9ab7cdaee568

Property mode set to 100755

File size: 70.1 KB

Line
1	#!/usr/bin/wish
2	##
3	## svxedit --
4	##
5	## Survex svx files editor.
6	##
7	## Copyright (C) 2002 Stacho Mudrak
8	##
9	##
10	## --------------------------------------------------------------------
11	## This program is free software; you can redistribute it and/or modify
12	## it under the terms of the GNU General Public License as published by
13	## the Free Software Foundation; either version 2 of the License, or
14	## any later version.
15	##
16	## This program is distributed in the hope that it will be useful,
17	## but WITHOUT ANY WARRANTY; without even the implied warranty of
18	## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19	## GNU General Public License for more details.
20	##
21	## You should have received a copy of the GNU General Public License
22	## along with this program; if not, write to the Free Software
23	## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
24	## --------------------------------------------------------------------
25
26
27
28
29
30
31
32
33	set xth(debug) 0
34
35
36
37	set xth(destroyed) 0
38	set xth(prj,name) "therion"
39	set xth(prj,title) "therion user interface"
40	set xth(gui,main) ".xth"
41	set xth(gui,about) ".xth_about"
42	set xth(gui,message) ".xthmsg"
43	set xth(gui,minsize) {480 300}
44
45	set xth(encodings) { iso8859-1 iso8859-2 iso8859-5 iso8859-7 utf-8 }
46	set xth(length_units) {m cm in ft yd}
47	set xth(angle_units) {deg min grad}
48	set xth(scrap_projections) {plan elevation extended none}
49	set xth(point_types) {station label pillar stalactite stalacmite}
50	set xth(line_types) {wall break contour}
51	set xth(app,te,filetypes) {
52	{{Therion files} {.th}}
53	{{Text files} {.txt}}
54	{{All files} {*}}
55	}
56	set xth(app,te,fileext) {.th}
57
58	set xth(app,me,filetypes) {
59	{{Therion 2D files} {.th2}}
60	{{Therion files} {.th}}
61	{{Scrap files} {.scrap}}
62	{{All files} {*}}
63	}
64
65	set xth(icmds) {survey}
66	set xth(cmds) {scrap data grade line area map}
67	set dfs {6s}
68	set dfss {4s}
69	set dfuf {6.1fx {-}}
70	set dfdf {+6.2fx {-}}
71	set dfcf {6.2fx {-}}
72	set dfccf {8.2f {-}}
73	set dfgf {{6.1fx} {up down -}}
74	set xth(datafmts) [list \
75	"unknown $dfs" \
76	"station $dfss" \
77	"from $dfss" \
78	"to $dfss" \
79	"compass $dfuf" \
80	"backcompass $dfuf" \
81	"bearing $dfuf" \
82	"backbearing $dfuf" \
83	"tape $dfcf" \
84	"length $dfcf" \
85	"count $dfccf" \
86	"counter $dfccf" \
87	"fromcount $dfccf" \
88	"tocount $dfccf" \
89	"fromcounter $dfccf" \
90	"tocounter $dfccf" \
91	"gradient $dfgf" \
92	"clino $dfgf" \
93	"backgradient $dfgf" \
94	"backclino $dfgf" \
95	"depth $dfdf" \
96	"fromdepth $dfdf" \
97	"todepth $dfdf" \
98	"depthchange $dfdf" \
99	"dx $dfcf" \
100	"dy $dfcf" \
101	"dz $dfcf" \
102	"northing $dfcf" \
103	"easting $dfcf" \
104	"altitude $dfcf" \
105	]
106
107	set xth(app,active) ""
108	set xth(app,list) {}
109	set xth(app,all,relw) -1
110	set xth(app,all,wmwd) 180
111	set xth(app,all,wpsw) 1
112
113	set xth(app,fencoding) iso8859-2
114	set xth(app,sencoding) iso8859-2
115
116	# autodetect some options
117	frame .def
118	scrollbar .def.scrollbar
119	text .def.text
120	label .def.label
121
122	set xth(gui,sbwidth) [.def.scrollbar cget -width]
123	set xth(gui,sbwidthb) [.def.scrollbar cget -borderwidth]
124	set xth(gui,lfont) [.def.label cget -font]
125	set xth(gui,efont) [.def.text cget -font]
126	set xth(gui,ecolorbg) black
127	set xth(gui,ecolorfg) green
128	set xth(gui,ecolorselbg) green
129	set xth(gui,ecolorselfg) black
130	set xth(gui,selfg) white
131	set xth(gui,selbg) darkBlue
132	set xth(gui,etabsize) 2
133	set xth(gui,controlk) Ctrl
134
135	destroy .def
136	# end of options autodetection
137
138	# map editor settings
139	set xth(gui,me,scrap,psize) 4
140	set xth(gui,me,point,psize) 4
141	set xth(gui,me,point,cpsize) 5
142	set xth(gui,me,line,psize) 4
143	set xth(gui,me,line,cpsize) 4
144	set xth(gui,me,line,spsize) 5
145
146	# platform dependend settings
147	case $tcl_platform(platform) {
148	unix {
149	set xth(gui,sbwidth) 9
150	set xth(gui,sbwidthb) 1
151	set xth(gui,lfont) "Helvetica 12"
152	set xth(gui,efont) {fixed 14 roman bold}
153	set xth(gui,platform) unix
154	set xth(gui,cursor) top_left_arrow
155	}
156	windows {
157	set xth(gui,efont) "Courier 16 roman bold"
158	set xth(gui,platform) windows
159	set xth(gui,cursor) arrow
160	}
161	macintosh {
162	set xth(gui,controlk) Cmd
163	set xth(gui,platform) macintosh
164	set xth(gui,cursor) arrow
165	}
166	}
167	# end of platform dependend settings
168
169	set xth(about,info) "xtherion v1.0 beta\n \u00A9 2002 Stacho Mudrak"
170	set xth(about,image_data) {
171	R0lGODlhwACQAOcAAAAAAAAAVQAAqgAA/wAkAAAkVQAkqgAk/wBJAABJVQBJ
172	qgBJ/wBtAABtVQBtqgBt/wCSAACSVQCSqgCS/wC2AAC2VQC2qgC2/wDbAADb
173	VQDbqgDb/wD/AAD/VQD/qgD//yQAACQAVSQAqiQA/yQkACQkVSQkqiQk/yRJ
174	ACRJVSRJqiRJ/yRtACRtVSRtqiRt/ySSACSSVSSSqiSS/yS2ACS2VSS2qiS2
175	/yTbACTbVSTbqiTb/yT/ACT/VST/qiT//0kAAEkAVUkAqkkA/0kkAEkkVUkk
176	qkkk/0lJAElJVUlJqklJ/0ltAEltVUltqklt/0mSAEmSVUmSqkmS/0m2AEm2
177	VUm2qkm2/0nbAEnbVUnbqknb/0n/AEn/VUn/qkn//20AAG0AVW0Aqm0A/20k
178	AG0kVW0kqm0k/21JAG1JVW1Jqm1J/21tAG1tVW1tqm1t/22SAG2SVW2Sqm2S
179	/222AG22VW22qm22/23bAG3bVW3bqm3b/23/AG3/VW3/qm3//5IAAJIAVZIA
180	qpIA/5IkAJIkVZIkqpIk/5JJAJJJVZJJqpJJ/5JtAJJtVZJtqpJt/5KSAJKS
181	VZKSqpKS/5K2AJK2VZK2qpK2/5LbAJLbVZLbqpLb/5L/AJL/VZL/qpL//7YA
182	ALYAVbYAqrYA/7YkALYkVbYkqrYk/7ZJALZJVbZJqrZJ/7ZtALZtVbZtqrZt
183	/7aSALaSVbaSqraS/7a2ALa2Vba2qra2/7bbALbbVbbbqrbb/7b/ALb/Vbb/
184	qrb//9sAANsAVdsAqtsA/9skANskVdskqtsk/9tJANtJVdtJqttJ/9ttANtt
185	Vdttqttt/9uSANuSVduSqtuS/9u2ANu2Vdu2qtu2/9vbANvbVdvbqtvb/9v/
186	ANv/Vdv/qtv///8AAP8AVf8Aqv8A//8kAP8kVf8kqv8k//9JAP9JVf9Jqv9J
187	//9tAP9tVf9tqv9t//+SAP+SVf+Sqv+S//+2AP+2Vf+2qv+2///bAP/bVf/b
188	qv/b////AP//Vf//qv///yH+CHh0aGVyaW9uACwAAAAAwACQAAAI/gABCBxI
189	sKDBgwgTKlzIsKHDhxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJ
190	sqXLjyRiloj5sqbNlDJJlJg586bPnxx1liiSpKjRJD2BKl0KUWfRNm0kQW1T
191	lCbTq1gL6kSSJI4kSbZsfaWaxGpWADFJoD1rk0SKJG7AapurS6wbpGrPOsWb
192	Ny9bnDvbOLKlbdu/bXPFIi3BtsTRpGv/ooyZJKotw/8yI7ZF1S/TvVOL7pzp
193	WXJHx5bDFtb2LbPrw9tsRSqblUTluF/dkC1b2jTHymB1bdu27zXmf/sQz+7t
194	U2iSSGHDSooUOilz3xOfgr083Hhh19rE/raB/FMm8NXRx3ZOq/Y69oW2K0cF
195	ixmha8RSyd/MCXy4YYH/jHUUUmXp915C8UHVyHaFCSSTQbBpI0sTBrbl2Hn/
196	DTTdXVJBZRRp7h0IgFHzbdfdQsOFJwleTJXAFVRz/WOQdtOFJppZ73n2FG6q
197	+ScJQaX9s5olbhAR4kt7JVHYNm0cVCBY6lXF2FU4akUQjWH5t81C2mgW3l1H
198	1uQcd0kglFds4lG1k1lhmrQXZOwBAIJAqEkiC2HbfJOhmSV4KV4RbMl0mTYM
199	babYYjrR1CZJSVaV00xzoiWfXMP5k5lCBJDgp5qSkaAaoe0d5MZm+ZHAlWNr
200	IplgG414KNpO/gAUAAABddoi3Gs/IlhcYdbkR4BpX3G3TSQLiXcUWUUsGhJq
201	uEXp6EC1XqZZsd5JVVYAps3HnYzFdqhbaL09mlZkHNUZnHQexhSpbaxaguel
202	C7nWmja6SNJEsr5Nyh1D0gUroH6NLpaqRjqlhp4turEYa63dwauQa8mFpeav
203	pkW75UJtRKdxwnBeGFUbbnxrVJUSsZvxZfvoGZu1UwLgWBpyyCJccf80Ga+f
204	kqSRgrLlAXfZQ4Ou3JlWwG2Xq40kO6RTE45YYs02ugh0i9BI0VlUXMI+dJ+x
205	LfvGLn0QwSYxbQRFS6iGkiRMdlNPZcmtQCqS9evXtjz9dkOH7ROe/iP38vxT
206	rWc75A9icZcJpM8NDqTNLVxHFJ+JewIgtJrsNuLuiVqTymmOTkUV3kNtaNb4
207	QHRHTrh4FR7UuYmZGS7QytY+ZZlw3zTykGHfaEPk2ti15zNmNjdEmCWbO4jh
208	3RFauyjdgx5UOInB2vKQJPcV7rdSpbsGkfWk/4682CvybmZRkdB3sUHGlrVj
209	WGG7pg/VFIvocmXv3l1o+uYdT5BmVIfp2FdLst9AGhefOMisfZlJzIqutxSG
210	Ra5QKxtQ25Z0pcOEhzPiMwjDtHcQWVhLICCwTSRkETy8ZUZPEhqa/Ixnmfrc
211	Dk1qKwrMZDacg1xGMalDSwnSYD4Ooi8O/uuJz0Tu078VDgRxDmuIoahToKIE
212	axv+QIjQUkcZzx1HgAKJnXMo4j6oWStSK4yJZb4TNlKxqHSBK4iQMNi1giDu
213	igiJHRIuxEXk6OkW1opfGJ+zLYi0AT93mVLBzIeQJESwQqhxm2tcVxAg8uYt
214	bZDDEP/Rmm30ajxG7B50pDWR6VRlfkmg1ELSlkGn9FB6CqGcpMZYQoZUazwM
215	bCBcCNMliqwICWlJJGEYUiqitTCJCOFUCH93PhPuql4qNKJj3NDHiahydYlT
216	CMv8YkpJfAeLbiRb6YrpSvCkMAlglN82sTnK4pWOX7HjiXa2xU0nWeeNEIkE
217	JcWWTHG+kZwH/mlDYjaXKcQxREWxuw19WANMJ5EgUoDDZ0IMo6KqKfOeEEmR
218	bIY2EwwVSoEbKt+2fJiQsoCAVuuMZkQKg7o25giiLwxLwvryu24aKjqIuaJC
219	R9Qej4HlaRRJji6I51B7WrGgCiFVIHvCMIYkIUIxvaalMoMEo/KEKPqay0Tk
220	qaJ76fE9y5TE1IC6UGvgr6ItRcluUHU1awJvImMzqW/qdM3tGQuX5hljO0fi
221	KhL8yoFcRWdnwmkap0CnrUDTIrTgiRLBWi1jdpupFI2VNL2UoA3QialiBSKW
222	8HlmmykRSxPWRjcyTsQNhcshVv4nrbwO5I+hJd38omK3zE6ThfQx/q3wWNa7
223	xzKzYa7UXNd2Ih88RREljD3oKmM7WYWIJwW9I6ZsAWBB2RSFdDZt5kkIWMXL
224	eWMfGFEpI/8COBcGlWq0AatlpvZAkozuQuYrr0Qi6LXH/nWpMz3M6EAKFeIK
225	CSXasBZcGebZiqRoRV7zHkftMxflda++tHzNPxiJBH44+MFNBdKDHxwmr7aq
226	KG9BXJeKW5DQNRfAndrggA+iOc4WDU8b5uiEJ1yQFT/4n4ciUCglkVgO749/
227	zq0Y+d7l3YUW8bBYC9prCOJiB7e4yPzaHWmIIGAbD6R6UiFCX+nH45pB0C5V
228	G2YS0lBfdxWGZndDB5IJImYXF4uxDnos/qUsNZHjxC2WK3mcLcibxniZ0XDx
229	kZ2JUkwQcPgZHyzu858DbRBNlTgvtGoCpdSbEA9nJjlf6mltEglYh4BvPRcq
230	ClfishqO+tnPhBbIp8ER6htv5i4o6Itt4mArzFnaO6iDM2DkymatkbRDEpyj
231	gCM36lL3+sUH8ROYBgICtkKRw4+m5KnLctWrkHZbrcSYkCa35dBARaMNuy8A
232	gPFpQD8YGwMBBwA+TQ4HXyeB2yBl17KHbCI6V7TN6W5j+WUXqkxlKk+8poL3
233	ve8EiNvSwwmuQPrJWlc3JGUSNTB3MSRpiUQJ3+VbNL8nvm+I5E5o+CJdEVpY
234	a4egUEWR0Blf/rFSOoWhNaDa6pFMKT7xiCqw4cWOCu04vA1vALSeeqFfuh1U
235	kYkmAZIGI05rWM7y7Rp3jSQUnym/Y/SEHMxD8C4PaqxEkfQJlD6oFImhp61Z
236	I2lFzbJ4yFEpqTc0B7iV8+5W7KCCtTqDxEuxSbpdvx6V9n1DH9qwhpJz9Ni0
237	Ay1N0PsZSbwUnjborDQBYFfWjXlrqhzIZG5QLUUyJgk5dMZniw8Jzp5FTZ+1
238	73QKX2vRciXrLJKlvmApyYcDGam7yjlqWlN2aEuvks7FpSNq01ZJTtcICnmm
239	2Fdz2lwTYseAW8vrfU0QWHiSEVc9J/UkOfSs6EQCorRw+PbZhzcs/mkJ5dG+
240	9lj6PgBYVl9ZWCL6DS2BHnkrh4E2nfgfJov4QeIec+Ep2g7vEMg0+inEvAb/
241	6xVplxUtE/ENehMbVJFxnJMaBld1XyEVEBg9KDZ0TuY8+TVsaZYEirZLBYh3
242	Zsc5JIBgnHQR/aJ/JdIjlWYR3EN9wCEcXFRi4lRF14d9DnEyAiIfbsB/2ZYR
243	nhJ6mDVEjZdB2BFd+uYaADhKKMd2YHELXVJLG0E5mUIUN8VoDOEPejI2OxNG
244	kqKDnbZccWQtuwEyXhZTHbEbIUUcXIRCGPR+yQUy24FiVKh2dYVgS0KDnQQV
245	aqAtKQgRxXFqaQAomeQUOSiBSeVMlUUd/vYWFe7CHW5nEf2yiP7nhcGWcA0n
246	Py5SGVc3KEbYSQ9YIm84F8PBhi4XFrqwJBRYR7fWBHOXSTrEFViib1VXWV8R
247	CY4QPYXRGhmRIgGkYFyUHPDDikCyOnjSY24lHZGAiAzYcRZxQsixchRRSVRT
248	AiPHiuN0GJ9lKPqlXBnRJxQnig+DY3chhKyIBHLVJWclEdIRSHDRQxxxDa9h
249	DRfRRYwlK8B4Jc83jIchiehTI5UxQsKhD9jFEUMWj1DmCEmggPW4WnsmWbEo
250	FRFXPx0xkMsoL4UzjYHoRLboH43IEG1QF7ZwJ1mCGXYYERJZEWMXIRg0f9iz
251	IxnZHUfoEN8B/l8LlhEleRHasA8RMzEJSTqgAVkMQowTQTMUWIEQMmLLaHxt
252	kIU7GYyBFyMj2U0VhxE1GY+584FLCSR4hRGONpUTwY1qVRGhgx/Fc5XZtIRx
253	OFJcCRRjo5I5dzJnSZJGqRQ8ZZFXqXgxIpBxqZZUQZc7WTCR9ZYIZI1YYSxk
254	eRBZuRET540hcZIK9l/jQQDYUpiDxUxbRZT20XIrQXHbd0nqJ5kHRin6aEL8
255	xhKakTd68g+Dg0NsuRRqsU6YoZgQwZhpORLmCBtJlRgYWJigEVmZ1xEpFpoY
256	cVQMRThzUZzoIo712DmbtJF4mZcfAXcXpDGy4EHr4ZkVdX2DN5sf/rEPg5MY
257	shgXIdMZX5mQcsaII6FgzOmbFhQ3riJ/q0klTpQlKcZIsjmTk7RvsJkdJ5Qn
258	KhKO7OF3fSliHIWZEkFxb0d4Y7M2BNBsnqlDcmUYkWMczvmNo/mcyIF3vWJZ
259	ZdOgCNFdoHg2vwmhiKGfFaqezXUo1EQuHIqVmBceHwqhq1GcSRVT3bENivmb
260	v3Ef3YlH1bmi8IEa9cV/cBidGqMx1lCHiqWdBQoxQmVyPooglCE7PKIa6ZEb
261	DxhxP/kNommZwZaPiLELlhAHn/SkStMoPtkvU9EE98ZlbmgivVmUCaQRG5Zw
262	OYOcZIogpEEj6WQbp7ITL6ItT1Oj9jkQ/iuXnzNyQtqHjWlgp3fKEKtyI2mW
263	KDqUYQw4HCpTEEM5ofCHoJLgSADaqHh6FFWCI3ElFy+KqaWpqfZhgOhhLcny
264	np4pFFFXNi1KpQO0ctq2PYQnIJ8Kqo6qojyHIC/ygMSakfqQmEaFqKvxFc+i
265	ELDqq8YjH/eGb1MIoVFJoQk3G0oJrS6RaZrGFS/Sdohxd0PZTYmqO42QBLjE
266	rTWRKeNCAB9VqrZwDf7Bi0H1aJthkLPKriWRNAVTqdugDwaITWNngGooFdvK
267	ry8Br+NzYviITcaxGUk3ngrbM7cxQnjiDRBLHNuXd5ZgkM9asRzhro6hpj3U
268	iOhmPSErsh0hfxNNIAchuSSMVHOWhD8se3af6B8EQSpMtDMMerMkBxwgWZwE
269	ETebta9AWx5/Gj1eRVnB9bNJS3JQpaYplx69h5BR21fq9BRYGgm6gbRZCxTj
270	Any3kaaVGLZsEUIMazVHMUe9irZZQbJCMS5wq4WlsbJ1m7d6u7d827d++7dk
271	GRAAOw==
272	====
273	}
274
275
276
277
278
279
280
281	# file extensions
282	set xth(app,te,filetypes) {
283	{{Survex files} {.svx}}
284	{{All files} {*}}
285	}
286	set xth(app,te,fileext) {.svx}
287
288	# command indenting
289	set xth(icmds) {}
290	set xth(cmds) {}
291	set xth(cmd,*begin) 2
292	set xth(endcmd,begin) "end"
293	set xth(cmd,*end) -2
294	set xth(endcmd,*end) ""
295
296	# application titles
297	set xth(prj,name) "svxedit"
298	set xth(prj,title) "survex source editor"
299	set xth(about,info) "svxedit v@VERSION@ (beta)\n \u00A9 2002 Stacho Mudrak"
300
301	# fonts :-)
302	case $tcl_platform(platform) {
303	unix {
304	set xth(gui,lfont) "Helvetica 10"
305	set xth(gui,efont) {fixed 10 roman}
306	}
307	windows {
308	set xth(gui,efont) "Courier 10 roman"
309	}
310	macintosh {
311	}
312	}
313
314
315
316
317
318
319
320	set xth(about,image_id) [image create photo -data $xth(about,image_data)]
321
322	proc xth_about_status {str} {
323	global xth
324	set xth(about,status) $str
325	update idletasks
326	}
327
328
329	proc xth_about_show {btnid} {
330	global xth
331	if {[winfo exists $xth(gui,about)]} xth_about_hide
332	xth_about_status ""
333	set w $xth(gui,about)
334	toplevel $w -relief raised -bg black -bd 3 -cursor $xth(gui,cursor)
335	wm transient $w
336	wm withdraw $w
337	set sw [winfo screenwidth .]
338	set sh [winfo screenheight .]
339	wm overrideredirect $w 1
340	label $w.image -bd 0 -relief sunken -background black -fg white -image $xth(about,image_id)
341	pack $w.image -side top -expand 1 -fill both
342	label $w.status -relief flat -background black -foreground white \
343	-textvariable xth(about,status) -font $xth(gui,lfont) -anchor center
344	pack $w.status -side top -expand 1 -fill both
345	label $w.info -bd 0 -relief sunken -background black -fg white -textvariable xth(about,info) \
346	-font $xth(gui,lfont) -anchor center
347	pack $w.info -side top -expand 1 -fill both -pady 5
348	if {$btnid} {
349	button $w.close -text "Close" -font $xth(gui,lfont) -anchor center \
350	-command xth_about_hide -width 5
351	pack $w.close -side top -fill none -anchor center -pady 5
352	focus $w.close
353	}
354	wm geometry $xth(gui,about) -$sw-$sh
355	wm deiconify $xth(gui,about)
356	update idletasks
357	set x [expr {($sw - [winfo width $xth(gui,about)])/2}]
358	set y [expr {($sh - [winfo height $xth(gui,about)])/2}]
359	wm geometry $xth(gui,about) +$x+$y
360	$w configure -bg black
361	$w.image configure -image $xth(about,image_id)
362	$w.info configure -textvariable xth(about,info)
363	update idletasks
364	}
365
366
367	proc xth_about_hide {} {
368	global xth
369	destroy $xth(gui,about)
370	focus $xth(gui,main)
371	}
372
373
374
375
376
377
378
379	# prepare the syntax commands
380	foreach cmd $xth(icmds) {
381	set xth(cmd,$cmd) 2
382	set xth(cmd,end$cmd) -2
383	}
384
385	foreach cmd $xth(cmds) {
386	set xth(cmd,$cmd) 1
387	set xth(endcmd,$cmd) end$cmd
388	set xth(cmd,end$cmd) -1
389	}
390
391	foreach datafmt $xth(datafmts) {
392	set qt [lindex $datafmt 0]
393	set xth(datafmt,$qt,format) [lindex $datafmt 1]
394	set xth(datafmt,$qt,special) [lindex $datafmt 2]
395	}
396
397
398
399
400
401
402
403	package require BWidget
404
405	# create xth window
406	wm withdraw .
407	xth_about_show 0
408	toplevel $xth(gui,main)
409	wm withdraw $xth(gui,main)
410	wm protocol $xth(gui,main) WM_DELETE_WINDOW "xth_exit"
411	wm title $xth(gui,main) $xth(prj,name)
412	wm geometry $xth(gui,main) [format "%dx%d+0+0" [lindex $xth(gui,minsize) 0] \
413	[lindex $xth(gui,minsize) 1]]
414	wm minsize $xth(gui,main) [lindex $xth(gui,minsize) 0] \
415	[lindex $xth(gui,minsize) 1]
416	update idletasks
417	bind $xth(gui,main) <Configure> {
418	catch {xth_app_place $xth(app,active)}
419	}
420
421	set xth(gui,clock) "00:00"
422
423	# redefine some public key bindigs
424	bind Text <Control-Key-o> "#"
425	bind Text <Control-Key-a> "#"
426	bind Text <Control-Key-i> "#"
427	bind Text <Control-Key-s> "#"
428	bind Text <Control-Key-w> "#"
429	bind Text <Control-Key-q> "#"
430	bind Text <Control-Key-x> "#"
431	bind Text <Control-Key-n> "#"
432	bind Text <Control-Key-p> "#"
433	bind Text <Control-Key-c> "#"
434	bind Text <Control-Key-v> "#"
435	bind Text <Control-Key-f> "#"
436	bind Text <Control-Key-h> "#"
437	set xth(gui,bind,text_tab) [bind Text <Tab>]
438	set xth(gui,bind,text_return) [bind Text <Return>]
439	bind Text <Tab> "#"
440	bind Text <Return> "#"
441
442
443
444
445
446
447
448
449
450	proc xth_status_bar {aname widg stext} {
451
452	global xth
453	set sbar $xth(gui,$aname).sf.sbar
454	set xth(gui,sbar,$widg,exp) 0
455	bind $widg <FocusIn> "+ if {\$xth(gui,sbar,$widg,exp) == 0} {set xth(gui,sbar,$widg,exp) 1; set xth(gui,sbar,$widg,otext) \[$sbar cget -text\]; $sbar configure -text \"$stext\"}"
456	bind $widg <Enter> "+ if {\$xth(gui,sbar,$widg,exp) == 0} {set xth(gui,sbar,$widg,exp) 1; set xth(gui,sbar,$widg,otext) \[$sbar cget -text\]; $sbar configure -text \"$stext\"}"
457	bind $widg <FocusOut> "+ if {\$xth(gui,sbar,$widg,exp) == 1} {$sbar configure -text \$xth(gui,sbar,$widg,otext); set xth(gui,sbar,$widg,exp) 0}"
458	bind $widg <Leave> "+ if {\$xth(gui,sbar,$widg,exp) == 1} {$sbar configure -text \$xth(gui,sbar,$widg,otext); set xth(gui,sbar,$widg,exp) 0}"
459
460	}
461
462	proc xth_status_bar_push aname {
463	global xth
464	set sbar $xth(gui,$aname).sf.sbar
465	if {![info exists xth(gui,sbar,$aname)]} {
466	set xth(gui,sbar,$aname) [$sbar cget -text]
467	} else {
468	set xth(gui,sbar,$aname) [lappend $xth(gui,sbar,$aname) [$sbar cget -text]]
469	}
470	}
471
472
473	proc xth_status_bar_pop aname {
474	global xth
475	set sbar $xth(gui,$aname).sf.sbar
476	if {! [info exists xth(gui,sbar,$aname)]} {
477	set xth(gui,sbar,$aname) ""
478	} else {
479	$sbar configure -text [lindex $xth(gui,sbar,$aname) 0]
480	set xth(gui,sbar,$aname) [lreplace $xth(gui,sbar,$aname) 0 0]
481	}
482	}
483
484
485	proc xth_status_bar_status {aname txt} {
486	global xth
487	set sbar $xth(gui,$aname).sf.sbar
488	$sbar configure -text $txt
489	update idletasks
490	}
491
492
493
494
495
496
497
498
499
500	proc xth_scroll_showcmd {sbar cmd} {
501	global xth
502	set xth(scroll,$sbar,show) $cmd
503	set xth(scroll,$sbar,open) 0
504	}
505
506	proc xth_scroll_hidecmd {sbar cmd} {
507	global xth
508	set xth(scroll,$sbar,hide) $cmd
509	set xth(scroll,$sbar,open) 0
510	}
511
512	proc xth_scroll {sbar first last} {
513	global xth
514	if {[expr $first == 0.0] && [expr $last == 1.0]} {
515	if {$xth(scroll,$sbar,open) == 1} {
516	set xth(scroll,$sbar,open) 0
517	eval $xth(scroll,$sbar,hide)
518	update idletasks
519	}
520	} else {
521	if {$xth(scroll,$sbar,open) == 0} {
522	set xth(scroll,$sbar,open) 1
523	eval $xth(scroll,$sbar,show)
524	update idletasks
525	}
526	$sbar set $first $last
527	}
528	}
529
530
531
532
533
534
535
536	set hm "$xth(gui,main).hmenu"
537	set xth(gui,menu,help) $hm
538
539	menu $hm -tearoff 0
540	$hm add command -label "About..." -underline 0 -font $xth(gui,lfont) \
541	-command {
542	xth_about_show 1
543	xth_about_status $xth(prj,title)
544	}
545
546
547
548
549
550
551
552	set xth(ctrl,all,number) 0
553
554	proc xth_ctrl_create {aname} {
555
556	global xth
557
558	set cf $xth(gui,$aname).af.ctrl
559
560	canvas $cf.c -yscrollcommand "xth_scroll $cf.sv" \
561	-highlightthickness 0
562	scrollbar $cf.sv -orient vert -command "$cf.c yview" -takefocus 0 \
563	-width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
564
565	grid columnconf $cf 0 -weight 1
566	grid rowconf $cf 0 -weight 1
567	xth_scroll_showcmd $cf.sv "grid $cf.sv -row 0 -column 1 -sticky nsew; update idletasks; xth_ctrl_reshape te"
568	xth_scroll_hidecmd $cf.sv "grid forget $cf.sv; update idletasks; xth_ctrl_reshape te"
569	grid $cf.c -row 0 -column 0 -sticky nsew
570
571	set xth(ctrl,$aname,number) 0
572	set xth(ctrl,$aname,list) {}
573	}
574
575	proc xth_ctrl_add {aname cname title} {
576
577	global xth
578
579	incr xth(ctrl,$aname,number)
580	incr xth(ctrl,all,number)
581	lappend xth(ctrl,$aname,list) $cname
582	set cn $xth(ctrl,$aname,number)
583	set cf $xth(gui,$aname).af.ctrl
584
585	set ccf $cf.cf$cn
586	frame $ccf
587	frame $ccf.f
588	set cid [$cf.c create window 0 0 -window $ccf -anchor nw]
589	set xth(ctrl,$aname,$cname) $ccf.f
590	set xth(ctrl,$aname,$cname,frm) $ccf
591	set xth(ctrl,$aname,$cname,pos) $cn
592	set xth(ctrl,$aname,$cname,max) 1
593	set xth(ctrl,$aname,$cname,menu) .xth_popup$xth(ctrl,all,number)
594	set xth(ctrl,$aname,$cn) $cid
595
596	menu .xth_popup$xth(ctrl,all,number) -tearoff 0
597	button $ccf.rb -text "$title" -command "xth_ctrl_minmax $aname $cname" \
598	-font $xth(gui,lfont) -bg #aaaaaa \
599	-fg white -bg darkBlue -activebackground lightBlue \
600	-anchor w -relief flat \
601	-takefocus 0
602	bind $ccf.rb <Button-3> "tk_popup .xth_popup$xth(ctrl,all,number) %X %Y"
603	xth_status_bar $aname $ccf.rb "Show or hide this control panel"
604
605	pack $ccf.rb -side top -fill x -expand 1
606	pack $ccf.f -expand yes -fill both
607
608	xth_ctrl_reshape $aname
609	}
610
611
612	proc xth_ctrl_finish {aname} {
613
614	global xth
615
616	foreach ct $xth(ctrl,$aname,list) {
617	set cmn $xth(ctrl,$aname,$ct,menu)
618	foreach oct $xth(ctrl,$aname,list) {
619	if {[string compare $ct $oct] != 0} {
620	$cmn add command -label [$xth(ctrl,$aname,$oct,frm).rb cget -text] \
621	-command "xth_ctrl_replace $aname $ct $oct" -font $xth(gui,lfont)
622	}
623	}
624	}
625
626	}
627
628
629	proc xth_ctrl_reshape {aname} {
630
631	global xth
632	set cn $xth(ctrl,$aname,number)
633	set cnv $xth(gui,$aname).af.ctrl.c
634
635	# position the windows
636	set height 0
637	set width [winfo width $cnv]
638	for {set i 1} {$i <= $cn} {incr i} {
639	set cid $xth(ctrl,$aname,$i)
640	set cw [$cnv itemcget $cid -window]
641	$cnv coord $cid 0 $height
642	$cnv itemconfigure $cid -width $width
643	incr height [winfo height $cw]
644	}
645
646	$cnv configure -scrollregion "0 0 $width $height"
647	}
648
649	proc xth_ctrl_minmax {aname cname} {
650
651	global xth
652
653	set cmm $xth(ctrl,$aname,$cname,max)
654	if {$cmm == 1} {
655	pack forget $xth(ctrl,$aname,$cname)
656	$xth(ctrl,$aname,$cname,frm).rb configure -relief raised
657	set cmm 0
658	} else {
659	pack $xth(ctrl,$aname,$cname) -expand yes -fill both
660	$xth(ctrl,$aname,$cname,frm).rb configure -relief flat
661	set cmm 1
662	}
663	set xth(ctrl,$aname,$cname,max) $cmm
664
665	update idletasks
666	xth_ctrl_reshape $aname
667	}
668
669	proc xth_ctrl_replace {aname ccname dcname} {
670
671	global xth
672
673	set cnv $xth(gui,$aname).af.ctrl.c
674	set p1 $xth(ctrl,$aname,$ccname,pos)
675	set p2 $xth(ctrl,$aname,$dcname,pos)
676
677	set xth(ctrl,$aname,$ccname,pos) $p2
678	set xth(ctrl,$aname,$dcname,pos) $p1
679	$cnv itemconfigure $xth(ctrl,$aname,$p1) \
680	-window $xth(ctrl,$aname,$dcname,frm)
681	$cnv itemconfigure $xth(ctrl,$aname,$p2) \
682	-window $xth(ctrl,$aname,$ccname,frm)
683
684	update idletasks
685	xth_ctrl_reshape $aname
686
687	}
688
689	proc xth_ctrl_minimize {aname cname} {
690	global xth
691	set xth(ctrl,$aname,$cname,max) 1
692	xth_ctrl_minmax $aname $cname
693	}
694
695	proc xth_ctrl_maximize {aname cname} {
696	global xth
697	set xth(ctrl,$aname,$cname,max) 0
698	xth_ctrl_minmax $aname $cname
699	}
700
701
702
703
704
705
706
707
708	proc xth_app_move_panel {aname xx} {
709	global xth
710	if {$xth(app,$aname,wpsw) == 1} {
711	set xth(app,$aname,relw) [expr [winfo width $xth(gui,main)] - $xx + $xth(app,$aname,wrtx)];
712	} else {
713	set xth(app,$aname,relw) [expr $xx - $xth(app,$aname,wrtx)];
714	}
715	xth_app_place $aname
716	}
717
718
719	proc xth_app_create {aname title} {
720
721	global xth
722
723	set aw "$xth(gui,main).$aname"
724	set xth(gui,$aname) $aw
725	set xth(app,list) [concat $xth(app,list) $aname]
726	if {![info exists xth(app,$aname,relw)]} {
727	set xth(app,$aname,relw) $xth(app,all,relw)
728	}
729	if {![info exists xth(app,$aname,wpsw)]} {
730	set xth(app,$aname,wpsw) $xth(app,all,wpsw)
731	}
732	if {![info exists xth(app,$aname,wmwd)]} {
733	set xth(app,$aname,wmwd) $xth(app,all,wmwd)
734	}
735
736	# create and configure application frames
737	frame $aw
738	frame $aw.af
739	frame $aw.af.apps
740	frame $aw.af.ctrl
741	frame $aw.af.lrhn -borderwidth 2 -relief raised -cursor sb_h_double_arrow
742	xth_status_bar $aname $aw.af.lrhn "Drag to resize control panel."
743
744	frame $aw.sf
745	set sbar $aw.sf.sbar
746	label $sbar -text "" -anchor w -relief sunken -font $xth(gui,lfont)
747	pack $sbar -side left -fill both -expand 1
748
749	bind $aw.af.lrhn <Configure> "set xth(app,$aname,wwid) \[winfo width $xth(gui,main)\]; set xth(app,$aname,wrtx) \[winfo rootx $xth(gui,main)]; xth_ctrl_reshape $aname"
750	bind $aw.af.lrhn <B1-Motion> "xth_app_move_panel $aname %X"
751
752	set amn $aw.menu
753	menu $amn -tearoff 0
754	set xth($aname,menu) $amn
755
756	set fmn $amn.file
757	menu $fmn -tearoff 0
758	$amn add cascade -label "File" -underline 0 -menu $fmn -font $xth(gui,lfont)
759	set xth($aname,menu,file) $fmn
760
761	set xth($aname,title) $title
762	set xth($aname,wtitle) [string tolower $title]
763
764	pack $aw.af -expand yes -fill both
765	pack $aw.sf -side bottom -fill x
766
767	set fr $xth(app,$aname,relw)
768	set minfr $xth(app,$aname,wmwd)
769	set lrhny [expr [winfo height $xth(gui,main)] - 64]
770	if {$fr < $minfr} {
771	set fr $minfr
772	} elseif {$fr > ([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))} {
773	set fr [expr {([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))}]
774	}
775	set xth(app,$aname,relw) $fr
776	set fr [expr 1.0 - $fr / double([winfo width $xth(gui,main)])]
777
778	if {$xth(app,$aname,wpsw) == 1} {
779	place $aw.af.apps -relx 0 -rely 0 -relheight 1 -relwidth $fr
780	place $aw.af.ctrl -relx $fr -rely 0 -relheight 1 -relwidth [expr 1.0 - $fr]
781	place $aw.af.lrhn -relx $fr -y $lrhny -width 8 -height 8 -anchor center
782	} else {
783	place $aw.af.ctrl -relx 0 -rely 0 -relheight 1 -relwidth $fr
784	place $aw.af.apps -relx $fr -rely 0 -relheight 1 -relwidth [expr 1.0 - $fr]
785	place $aw.af.lrhn -relx $fr -y $lrhny -width 8 -height 8 -anchor center
786	}
787
788	xth_ctrl_create $aname
789
790	}
791
792
793	proc xth_app_clock {} {
794	global xth
795	set xth(gui,clock) [clock format [clock seconds] -format "%H:%M"]
796	after 15000 xth_app_clock
797	}
798
799
800	proc xth_app_place {aname} {
801
802	global xth
803	set aw "$xth(gui,main).$aname"
804
805	set fr $xth(app,$aname,relw)
806	set minfr $xth(app,$aname,wmwd)
807	if {$fr < $minfr} {
808	set fr $minfr
809	} elseif {$fr > ([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))} {
810	set fr [expr {([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))}]
811	}
812	set xth(app,$aname,relw) $fr
813	set fr [expr 1.0 - $fr / double([winfo width $xth(gui,main)])]
814
815	set lrhny [expr [winfo height $xth(gui,main)] - 64]
816
817	if {$xth(app,$aname,wpsw) == 1} {
818	place configure $aw.af.apps -relx 0 -relwidth $fr
819	place configure $aw.af.ctrl -relx $fr -relwidth [expr 1.0 - $fr]
820	place configure $aw.af.lrhn -relx $fr -y $lrhny
821	} else {
822	place configure $aw.af.apps -relx [expr 1.0 - $fr] -relwidth $fr
823	place configure $aw.af.ctrl -relx 0 -relwidth [expr 1.0 - $fr]
824	place configure $aw.af.lrhn -relx [expr 1.0 - $fr] -y $lrhny
825	}
826
827	xth_ctrl_reshape $aname
828	}
829
830	proc xth_app_switch {} {
831
832	global xth
833
834	set aname $xth(app,active)
835
836	if {$xth(app,$aname,wpsw) == 1} {
837	set xth(app,$aname,wpsw) 0
838	} else {
839	set xth(app,$aname,wpsw) 1
840	}
841
842	xth_app_place $aname
843	}
844
845
846	proc xth_app_finish {} {
847
848	global xth
849
850	# add Window menu to each menu
851	set m "$xth(gui,main).wmenu"
852	menu $m -tearoff 0
853	set i 0
854
855	set xth(gui,menu,window) $m
856
857	foreach aname $xth(app,list) {
858
859	if {[llength $xth(app,list)] > 1} {
860	set i [expr $i + 1]
861	$m add command -label $xth($aname,title) -accelerator "F$i" \
862	-command "xth_app_show $aname" -font $xth(gui,lfont)
863	bind $xth(gui,main) <F$i> "xth_app_show $aname"
864	}
865
866	# add clock to aname
867	set clockbar $xth(gui,$aname).sf.clockbar
868	label $clockbar -textvariable xth(gui,clock) -anchor center \
869	-relief sunken -font $xth(gui,lfont) -width 5
870	pack $clockbar -side left
871
872	}
873	if {[llength $xth(app,list)] > 1} {
874	$m add separator
875	}
876	$m add command -label "Switch panels" -underline 1 \
877	-command "xth_app_switch" -font $xth(gui,lfont)
878
879	if {$xth(debug)} {
880	set dm "$xth(gui,main).dmenu"
881	menu $dm -tearoff 0
882
883	$dm add command -label "Refresh procs" -underline 0 -command {
884	source te_sdata.tcl
885	source me_cmds.tcl
886	source me_cmds2.tcl
887	} -font $xth(gui,lfont)
888	$dm add command -label "Screen dump" -underline 0 -command {
889	after 5000 {xwd -out screendump -frame}
890	} -font $xth(gui,lfont)
891	$dm add separator
892	$dm add command -label "Show command console" -underline 1 \
893	-command "wm deiconify .; wm transient . $xth(gui,main)" -font $xth(gui,lfont)
894	$dm add command -label "Hide command console" -underline 1 \
895	-command "wm withdraw ." -font $xth(gui,lfont)
896	}
897
898	bind $xth(gui,main) <Control-Key-q> "xth_exit"
899	bind $xth(gui,main) <Control-Key-o> xth_app_control_o
900	bind $xth(gui,main) <Control-Key-w> xth_app_control_w
901	bind $xth(gui,main) <Control-Key-s> xth_app_control_s
902	bind $xth(gui,main) <Control-Key-z> xth_app_control_z
903	bind $xth(gui,main) <Control-Key-y> xth_app_control_y
904	bind $xth(gui,main) <Control-Key-p> xth_app_control_p
905	bind $xth(gui,main) <Control-Key-l> xth_app_control_l
906	bind $xth(gui,main) <Control-Key-d> xth_app_control_d
907	bind $xth(gui,main) <Key-Escape> xth_app_escape
908	foreach aname $xth(app,list) {
909	$xth($aname,menu) add cascade -label "Window" -menu $m -underline 0 \
910	-font $xth(gui,lfont)
911	if $xth(debug) {
912	$xth($aname,menu) add cascade -label "Debug" -menu $dm -underline 0 \
913	-font $xth(gui,lfont)
914	}
915	$xth($aname,menu,file) add separator
916	case $xth(gui,platform) {
917	macintosh {
918	$xth($aname,menu,file) add command -label "Quit" -underline 0 \
919	-command "xth_exit" -font $xth(gui,lfont) \
920	-accelerator "$xth(gui,controlk)-q"
921	}
922	default {
923	$xth($aname,menu,file) add command -label "Exit" -underline 1 \
924	-command "xth_exit" -font $xth(gui,lfont) \
925	-accelerator "$xth(gui,controlk)-q"
926	}
927	}
928	$xth($aname,menu) add cascade -label "Help" -menu $xth(gui,menu,help) \
929	-underline 0 -font $xth(gui,lfont)
930	}
931
932	}
933
934	proc xth_app_title {aname} {
935
936	global xth
937
938	# set the application menu
939	set ofn ""
940	if {[info exists xth($aname,open_file)]} {
941	set ofn $xth($aname,open_file)
942	}
943	if {[string length $xth($aname,wtitle)] > 0} {
944	set atit " $xth($aname,wtitle)"
945	} else {
946	set atit ""
947	}
948	if {[string length $ofn] > 0} {
949	wm title $xth(gui,main) "$xth(prj,name)$atit - $xth($aname,open_file)"
950	} else {
951	wm title $xth(gui,main) "$xth(prj,name)$atit"
952	}
953	}
954
955	proc xth_app_control_o {} {
956
957	global xth
958
959	# puts $xth(app,active)
960	switch $xth(app,active) {
961	te {xth_te_open_file 1 {} 1}
962	me {xth_me_open_file 1 {} 1}
963	}
964	}
965
966	proc xth_app_control_w {} {
967
968	global xth
969
970	# puts $xth(app,active)
971	switch $xth(app,active) {
972	me {xth_me_close_file}
973	}
974	}
975
976	proc xth_app_control_s {} {
977
978	global xth
979
980	# puts $xth(app,active)
981	switch $xth(app,active) {
982	me {xth_me_save_file 0}
983	}
984	}
985
986
987	proc xth_app_control_z {} {
988
989	global xth
990
991	# puts $xth(app,active)
992	switch $xth(app,active) {
993	me {xth_me_unredo_undo}
994	}
995
996	}
997
998	proc xth_app_control_y {} {
999
1000	global xth
1001
1002	# puts $xth(app,active)
1003	switch $xth(app,active) {
1004	me {xth_me_unredo_redo}
1005	}
1006	}
1007
1008	proc xth_app_control_p {} {
1009	global xth
1010	switch $xth(app,active) {
1011	me {xth_me_cmds_set_mode 1}
1012	}
1013	}
1014
1015
1016	proc xth_app_control_d {} {
1017	global xth
1018	switch $xth(app,active) {
1019	me {xth_me_cmds_delete {}}
1020	}
1021	}
1022
1023
1024	proc xth_app_control_l {} {
1025	global xth
1026	switch $xth(app,active) {
1027	me {xth_me_cmds_create_line {} 1 "" "" ""}
1028	}
1029	}
1030
1031
1032	proc xth_app_escape {} {
1033	global xth
1034	switch $xth(app,active) {
1035	me {xth_me_cmds_set_mode 0}
1036	}
1037	}
1038
1039
1040	proc xth_app_show {aname} {
1041
1042	global xth
1043
1044	if {$xth(app,active) != ""} {
1045	pack forget $xth(gui,$xth(app,active))
1046	}
1047
1048	set xth(app,active) $aname
1049	pack $xth(gui,$aname) -expand yes -fill both
1050
1051	xth_app_title $aname
1052
1053	$xth(gui,main) configure -menu $xth($aname,menu)
1054
1055	regexp {([0-9]+)x([0-9]+)} [winfo geometry $xth(gui,main)] geom xsize ysize
1056
1057	if {($xsize < [lindex $xth(gui,minsize) 0]) \|\| \
1058	($ysize < [lindex $xth(gui,minsize) 1])} {
1059	if {($xsize < [lindex $xth(gui,minsize) 0])} {
1060	set xsize [lindex $xth(gui,minsize) 0]
1061	}
1062	if {($ysize < [lindex $xth(gui,minsize) 1])} {
1063	set ysize [lindex $xth(gui,minsize) 1]
1064	}
1065	set ogeom [winfo geometry $xth(gui,main)]
1066	regsub $geom $ogeom [format "%sx%s" $xsize $ysize] ngeom
1067	wm geometry $xth(gui,main) $ngeom
1068	}
1069
1070	update idletasks
1071	xth_ctrl_reshape $aname
1072	}
1073
1074
1075	proc xth_exit {} {
1076
1077	global xth
1078
1079	# save all open text editor files
1080	if {![info exists xth(te,flist)]} {
1081	set xth(te,flist) {}
1082	}
1083
1084	foreach cfid $xth(te,flist) {
1085	if {[xth_te_before_close_file $cfid yesnocancel] == 0} {
1086	return
1087	}
1088	}
1089
1090	if {[info exists xth(me,fopen)]} {
1091	if {$xth(me,fopen) == 1} {
1092	if {[xth_me_before_close_file yesnocancel] == 0} {
1093	return
1094	}
1095	}
1096	}
1097
1098	destroy .
1099
1100	}
1101
1102
1103	proc xth_app_normalize {} {
1104	global xth
1105	set twd [expr int(0.8 * [winfo screenwidth $xth(gui,main)])]
1106	if {$twd < [lindex $xth(gui,minsize) 0]} {
1107	set twd [lindex $xth(gui,minsize) 0]
1108	}
1109	set thg [expr int(0.8 * [winfo screenheight $xth(gui,main)])]
1110	if {$thg < [lindex $xth(gui,minsize) 1]} {
1111	set thg [lindex $xth(gui,minsize) 1]
1112	}
1113	set tpx [expr int(0.5 * ([winfo screenwidth $xth(gui,main)] - $twd))]
1114	set tpy [expr int(0.5 * ([winfo screenheight $xth(gui,main)] - $thg))]
1115	wm geometry $xth(gui,main) [format "%dx%d+%d+%d" $twd $thg $tpx $tpy]
1116	update
1117	regexp {([0-9]+)x([0-9]+)\+([0-9]+)\+([0-9]+)} [winfo geometry $xth(gui,main)] geom xsize ysize xshft yshft
1118	wm geometry $xth(gui,main) [format "%dx%d+%d+%d" [expr $twd - $xshft + $tpx] \
1119	[expr $thg - $yshft + $tpy] $tpx $tpy]
1120	update
1121	}
1122
1123	proc xth_app_clipboard {ev} {
1124	global xth
1125	set w [focus -lastfor $xth(gui,main)]
1126	if {[winfo ismapped $w]} {
1127	switch $ev {
1128	cut {
1129	event generate $w <<Cut>>
1130	}
1131	copy {
1132	event generate $w <<Copy>>
1133	}
1134	paste {
1135	event generate $w <<Paste>>
1136	}
1137	}
1138	}
1139	}
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150	xth_about_status "loading text editor..."
1151
1152	if {[string equal -nocase $xth(prj,name) svxedit]} {
1153	xth_app_create te {}
1154	} else {
1155	xth_app_create te "Text Editor"
1156	}
1157
1158	xth_ctrl_add te files "Files"
1159	xth_ctrl_add te sdata "Data table"
1160	xth_ctrl_finish te
1161
1162	set xth(te,open_file_encoding) $xth(app,fencoding)
1163
1164	set xth(te,bind,text_tab) {
1165	if { [string equal [%W cget -state] "normal"] } {
1166	xth_te_insert_tab %W
1167	break
1168	}
1169	}
1170
1171	set xth(te,bind,text_return) {
1172	regexp {(\d+)\.} [%W index insert] dum cln
1173	set spcs ""
1174	regexp {^\s+} [%W get $cln.0 $cln.end] spcs
1175	set spcsc [string length $spcs]
1176	set indct [string length [xth_te_get_indent %W $cln.0 1]]
1177	if {$spcsc == $indct} {
1178	} elseif {$spcsc > $indct} {
1179	%W delete $cln.0 $cln.[expr $spcsc - $indct]
1180	} elseif {$spcsc < $indct} {
1181	%W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
1182	}
1183	xth_te_insert_text %W "\n[xth_te_get_indent %W [expr $cln + 1].0 0]"
1184	}
1185
1186
1187	proc xth_te_insert_text {w s} {
1188	if {[string equal $s ""] \|\| [string equal [$w cget -state] "disabled"]} {
1189	return
1190	}
1191	set compound 0
1192	catch {
1193	if {[$w compare sel.first <= insert] \
1194	&& [$w compare sel.last >= insert]} {
1195	set oldSeparator [$w cget -autoseparators]
1196	if { $oldSeparator } {
1197	$w configure -autoseparators 0
1198	$w edit separator
1199	set compound 1
1200	}
1201	$w delete sel.first sel.last
1202	}
1203	}
1204	$w insert insert $s
1205	$w see insert
1206	if { $compound && $oldSeparator } {
1207	$w edit separator
1208	$w configure -autoseparators 1
1209	}
1210	}
1211
1212
1213	proc xth_te_insert_tab W {
1214	global xth
1215	regexp {\.(\d+)} [$W index insert] dum col
1216	set nsp [expr $xth(gui,etabsize) - ($col % $xth(gui,etabsize))]
1217	xth_te_insert_text $W [format \x25$nsp\s " "]
1218	focus $W
1219	}
1220
1221
1222	proc xth_te_sdata_enable {w} {
1223	global xth
1224	if {[string length $w] < 1} {
1225	set w $xth(ctrl,te,sdata)
1226	}
1227	set chlist [winfo children $w]
1228	if {[llength $chlist] > 0} {
1229	foreach sdw $chlist {
1230	catch {$sdw configure -state normal}
1231	catch {xth_te_sdata_enable $sdw}
1232	}
1233	}
1234	}
1235
1236	proc xth_te_sdata_disable {w} {
1237	global xth
1238	if {[string length $w] < 1} {
1239	set w $xth(ctrl,te,sdata)
1240	}
1241	set chlist [winfo children $w]
1242	if {[llength $chlist] > 0} {
1243	foreach sdw $chlist {
1244	catch {$sdw configure -state disabled}
1245	catch {xth_te_sdata_disable $sdw}
1246	}
1247	}
1248	}
1249
1250
1251	set xth(te,flist) {}
1252	set xth(te,fcurr) -1
1253	set xth(te,fltid) 0
1254
1255	# create position bar
1256	set pbar $xth(gui,te).sf.pbar
1257	label $pbar -text "1.0" -width 8 -relief sunken -font $xth(gui,lfont)
1258	pack $pbar -side left
1259
1260
1261	# file control
1262	frame $xth(ctrl,te,files).fl
1263	set flbox $xth(ctrl,te,files).fl.flbox
1264	listbox $flbox -height 6 -selectmode single -takefocus 1 \
1265	-yscrollcommand "xth_scroll $xth(ctrl,te,files).fl.sv" \
1266	-xscrollcommand "xth_scroll $xth(ctrl,te,files).fl.sh" \
1267	-font $xth(gui,lfont) -exportselection no \
1268	-selectborderwidth 1
1269
1270	scrollbar $xth(ctrl,te,files).fl.sv -orient vert -command "$flbox yview" \
1271	-takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
1272	scrollbar $xth(ctrl,te,files).fl.sh -orient horiz -command "$flbox xview" \
1273	-takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
1274	frame $xth(ctrl,te,files).ef
1275
1276
1277	bind $flbox <<ListboxSelect>> "xth_te_show_file \[lindex \[%W curselection\] 0\]"
1278
1279	grid columnconf $xth(ctrl,te,files).fl 0 -weight 1
1280	grid rowconf $xth(ctrl,te,files).fl 0 -weight 1
1281	grid $flbox -column 0 -row 0 -sticky news
1282	xth_scroll_showcmd $xth(ctrl,te,files).fl.sv "grid $xth(ctrl,te,files).fl.sv -column 1 -row 0 -sticky news"
1283	xth_scroll_hidecmd $xth(ctrl,te,files).fl.sv "grid forget $xth(ctrl,te,files).fl.sv"
1284	xth_scroll_showcmd $xth(ctrl,te,files).fl.sh "grid $xth(ctrl,te,files).fl.sh -column 0 -row 1 -sticky news"
1285	xth_scroll_hidecmd $xth(ctrl,te,files).fl.sh "grid forget $xth(ctrl,te,files).fl.sh"
1286	xth_status_bar te $flbox "Switch open files."
1287	grid columnconf $xth(ctrl,te,files) 0 -weight 1
1288	grid $xth(ctrl,te,files).fl -column 0 -row 0 -sticky news
1289	if {![string equal -nocase $xth(prj,name) svxedit]} {
1290	grid $xth(ctrl,te,files).ef -column 0 -row 1 -sticky news
1291	}
1292	Label $xth(ctrl,te,files).ef.ecl -text Encoding -anchor e -font $xth(gui,lfont) -state disabled
1293	ComboBox $xth(ctrl,te,files).ef.ecb -values $xth(encodings) \
1294	-textvariable xth(te,open_file_encoding) \
1295	-font $xth(gui,lfont) -height 4 -command xth_te_set_encoding \
1296	-state disabled
1297	Button $xth(ctrl,te,files).ef.chb -text "Change to" -anchor e -font $xth(gui,lfont) -padx 1 -state disabled -command xth_te_set_encoding
1298	Label $xth(ctrl,te,files).ef.cel -text "" -anchor w -padx 2 -font $xth(gui,lfont) -state disabled
1299	#grid columnconf $xth(ctrl,te,files).ef 0 -weight 0
1300	grid columnconf $xth(ctrl,te,files).ef 1 -weight 1
1301	grid $xth(ctrl,te,files).ef.ecl -column 0 -row 0 -sticky news
1302	grid $xth(ctrl,te,files).ef.cel -column 1 -row 0 -sticky news
1303	grid $xth(ctrl,te,files).ef.chb -column 0 -row 1 -sticky news
1304	grid $xth(ctrl,te,files).ef.ecb -column 1 -row 1 -sticky ew
1305	xth_status_bar te $xth(ctrl,te,files).ef "To set file encoding, type encoding name and press <Change> button."
1306
1307	frame $xth(gui,te).af.apps.ff -bg $xth(gui,ecolorbg)
1308	pack $xth(gui,te).af.apps.ff -fill both -expand yes
1309
1310
1311
1312	# table control
1313	Button $xth(ctrl,te,sdata).sfb -text "Scan data format" \
1314	-font $xth(gui,lfont) -state disabled
1315	xth_status_bar te $xth(ctrl,te,sdata).sfb \
1316	"Scan data format and rebuild survey data insertion tool."
1317
1318	checkbutton $xth(ctrl,te,sdata).sfs -text "Enter station names" -anchor w \
1319	-font $xth(gui,lfont) -variable xth(te,sdata,es) -state disabled
1320	xth_status_bar te $xth(ctrl,te,sdata).sfs \
1321	"Check if you want to insert station names for each shot."
1322
1323	frame $xth(ctrl,te,sdata).sdf
1324
1325	button $xth(ctrl,te,sdata).taf -text "Auto format selection" \
1326	-font $xth(gui,lfont) -state disabled
1327	xth_status_bar te $xth(ctrl,te,sdata).taf "Format selection to given table."
1328
1329	grid columnconf $xth(ctrl,te,sdata) 0 -weight 1
1330	grid $xth(ctrl,te,sdata).sfb -column 0 -row 0 -sticky nsew
1331	grid $xth(ctrl,te,sdata).sdf -column 0 -row 1 -sticky nsew
1332	grid $xth(ctrl,te,sdata).sfs -column 0 -row 2 -sticky nsew
1333	grid $xth(ctrl,te,sdata).taf -column 0 -row 3 -sticky nsew
1334
1335
1336
1337	proc xth_te_show_file {fidx} {
1338
1339	global xth
1340
1341	if {$xth(te,fcurr) >= 0} {
1342	pack forget $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame)
1343	}
1344
1345	if {$fidx < 0} {
1346	set fidx 0
1347	}
1348	if {$fidx >= [llength $xth(te,flist)]} {
1349	set fidx [expr [llength $xth(te,flist)] - 1]
1350	}
1351
1352	set xth(te,fcurr) $fidx
1353	if {$xth(te,fcurr) >= 0} {
1354	set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
1355	pack $xth(te,$cfid,frame) -expand yes -fill both
1356	$xth(ctrl,te,files).fl.flbox delete $xth(te,fcurr)
1357	$xth(ctrl,te,files).fl.flbox insert $xth(te,fcurr) "[expr $xth(te,fcurr) + 1]. $xth(te,$cfid,name) ($xth(te,$cfid,path))"
1358	$xth(ctrl,te,files).fl.flbox see $fidx
1359	$xth(ctrl,te,files).fl.flbox selection clear 0 end
1360	$xth(ctrl,te,files).fl.flbox selection set $fidx $fidx
1361	focus $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
1362	set xth(te,open_file) $xth(te,$cfid,name)
1363	# set xth(te,open_file_encoding) $xth(te,$cfid,encoding)
1364	$xth(ctrl,te,files).ef.cel configure -text $xth(te,$cfid,encoding)
1365	$xth(ctrl,te,files).ef.ecl configure -state normal
1366	$xth(ctrl,te,files).ef.ecb configure -state normal
1367	$xth(ctrl,te,files).ef.chb configure -state normal
1368	$xth(ctrl,te,files).ef.cel configure -state normal
1369	$xth(te,menu) entryconfigure Edit -state normal
1370	$xth(te,menu,file) entryconfigure "Save" -state normal
1371	$xth(te,menu,file) entryconfigure "Save as" -state normal
1372	$xth(te,menu,file) entryconfigure "Save all" -state normal
1373	$xth(te,menu,file) entryconfigure "Close" -state normal
1374	if {[llength $xth(te,flist)] > 1} {
1375	$xth(te,menu,file) entryconfigure "Next" -state normal
1376	$xth(te,menu,file) entryconfigure "Previous" -state normal
1377	} else {
1378	$xth(te,menu,file) entryconfigure "Next" -state disabled
1379	$xth(te,menu,file) entryconfigure "Previous" -state disabled
1380	}
1381	xth_te_sdata_enable ""
1382	} else {
1383	set xth(te,open_file) ""
1384	set xth(te,open_file_encoding) $xth(app,fencoding)
1385	$xth(te,menu,file) entryconfigure "Save" -state disabled
1386	$xth(te,menu,file) entryconfigure "Save as" -state disabled
1387	$xth(te,menu,file) entryconfigure "Save all" -state disabled
1388	$xth(te,menu,file) entryconfigure "Close" -state disabled
1389	$xth(te,menu,file) entryconfigure "Next" -state disabled
1390	$xth(te,menu,file) entryconfigure "Previous" -state disabled
1391	$xth(ctrl,te,files).ef.ecl configure -state disabled
1392	$xth(ctrl,te,files).ef.ecb configure -state disabled
1393	$xth(ctrl,te,files).ef.chb configure -state disabled
1394	$xth(ctrl,te,files).ef.cel configure -state disabled -text ""
1395	xth_te_sdata_disable ""
1396	$xth(te,menu) entryconfigure Edit -state disabled
1397	}
1398	xth_app_title te
1399
1400	}
1401
1402
1403	proc xth_te_set_encoding {} {
1404
1405	global xth
1406
1407	if {$xth(te,fcurr) >= 0} {
1408	# convert encoding into system's one
1409	set rxp "\\s+($xth(te,open_file_encoding))\\s+"
1410	if {[regexp -nocase $rxp $xth(encodings) dum temp]} {
1411	set xth(te,open_file_encoding) $temp
1412	set xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],encoding) $temp
1413	$xth(ctrl,te,files).ef.cel configure -text $temp
1414	} else {
1415	MessageDlg $xth(gui,message) -parent $xth(gui,main) \
1416	-icon error -type ok \
1417	-message "uknown encoding -- $xth(te,open_file_encoding)" \
1418	-font $xth(gui,lfont)
1419	}
1420	}
1421	}
1422
1423	proc xth_te_switch_file {fdr} {
1424	global xth
1425	set cf $xth(te,fcurr)
1426	if {$cf != -1} {
1427	incr cf $fdr
1428	if {$cf < 0} {
1429	set cf [expr [llength $xth(te,flist)] - 1]
1430	}
1431	if {$cf >= [llength $xth(te,flist)]} {
1432	set cf 0
1433	}
1434	xth_te_show_file $cf
1435	}
1436	}
1437
1438
1439	proc xth_te_create_file {} {
1440
1441	global xth
1442
1443	# create file variables
1444	incr xth(te,fltid)
1445	set cfid $xth(te,fltid)
1446	set xth(te,$cfid,name) [format "noname%02d$xth(app,te,fileext)" $cfid]
1447	set xth(te,$cfid,path) [file join [pwd] $xth(te,$cfid,name)]
1448	set xth(te,$cfid,newf) 1
1449	set xth(te,$cfid,encoding) $xth(app,fencoding)
1450	set xth(te,$cfid,frame) $xth(gui,te).af.apps.ff.file$cfid
1451	set cfr $xth(te,$cfid,frame)
1452
1453	# create the frame and bind the events
1454	frame $cfr
1455	text $cfr.txt -font $xth(gui,efont) -bg $xth(gui,ecolorbg) \
1456	-fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
1457	-yscrollcommand "$cfr.sv set" \
1458	-xscrollcommand "$cfr.sh set" \
1459	-relief sunken \
1460	-selectbackground $xth(gui,ecolorselbg) \
1461	-selectforeground $xth(gui,ecolorselfg) \
1462	-selectborderwidth 0 \
1463	-wrap none
1464	set xth(te,$cfid,otext) [$cfr.txt get 1.0 end]
1465	scrollbar $cfr.sv -orient vert -command "$cfr.txt yview" \
1466	-takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
1467	scrollbar $cfr.sh -orient horiz -command "$cfr.txt xview" \
1468	-takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
1469	bind $cfr.txt <Tab> $xth(te,bind,text_tab)
1470	bind $cfr.txt <Return> $xth(te,bind,text_return)
1471	bind $cfr.txt <<xthPositionChange>> "xth_te_update_position $cfr.txt"
1472	bind $cfr.txt <Key> "+ event generate $cfr.txt <<xthPositionChange>> -when tail"
1473	bind $cfr.txt <Button-1> "+ event generate $cfr.txt <<xthPositionChange>> -when tail"
1474	bind $cfr.txt <Control-Key-1> "xth_te_show_file 0"
1475	bind $cfr.txt <Control-Key-2> "xth_te_show_file 1"
1476	bind $cfr.txt <Control-Key-3> "xth_te_show_file 2"
1477	bind $cfr.txt <Control-Key-4> "xth_te_show_file 3"
1478	bind $cfr.txt <Control-Key-5> "xth_te_show_file 4"
1479	bind $cfr.txt <Control-Key-6> "xth_te_show_file 5"
1480	bind $cfr.txt <Control-Key-7> "xth_te_show_file 6"
1481	bind $cfr.txt <Control-Key-8> "xth_te_show_file 7"
1482	bind $cfr.txt <Control-Key-9> "xth_te_show_file 8"
1483	bind $cfr.txt <Control-Key-0> "xth_te_show_file 9"
1484	bind $cfr.txt <Control-Key-n> "xth_te_switch_file 1"
1485	bind $cfr.txt <Control-Key-p> "xth_te_switch_file -1"
1486	bind $cfr.txt <Control-Key-w> "xth_te_close_file"
1487	bind $cfr.txt <Control-Key-a> "xth_te_select_all"
1488	bind $cfr.txt <Control-Key-i> "xth_te_auto_indent"
1489	bind $cfr.txt <Control-Key-s> "xth_te_save_file 0 $cfid"
1490	bind $cfr.txt <Destroy> "xth_te_before_close_file $cfid yesno"
1491	# if {$xth(gui,bindclip) == 1} {
1492	bind $cfr.txt <Control-Key-x> "tk_textCut $cfr.txt"
1493	bind $cfr.txt <Control-Key-c> "tk_textCopy $cfr.txt"
1494	bind $cfr.txt <Control-Key-v> "tk_textPaste $cfr.txt"
1495	# }
1496
1497	grid columnconf $cfr 0 -weight 1
1498	grid rowconf $cfr 0 -weight 1
1499	grid $cfr.txt -column 0 -row 0 -sticky news
1500	grid $cfr.sv -column 1 -row 0 -sticky news
1501	grid $cfr.sh -column 0 -row 1 -sticky news
1502
1503
1504	# add file to list and listbox
1505	set xth(te,flist) [linsert $xth(te,flist) end $cfid]
1506	$xth(ctrl,te,files).fl.flbox insert end "[llength $xth(te,flist)]. $xth(te,$cfid,name) ($xth(te,$cfid,path))"
1507
1508	xth_te_show_file [expr [llength $xth(te,flist)] - 1]
1509	}
1510
1511
1512	# xth_te_read_file --
1513	#
1514	# return list containing
1515	# {success name encoding text}
1516
1517	proc xth_te_read_file {pth} {
1518
1519	global errorInfo xth
1520
1521	set curenc utf-8
1522	set nm [file tail $pth]
1523	set encspc 0
1524	set flnn 0
1525	set success 1
1526	set txt ""
1527	if {[catch {set fid [open $pth r]}]} {
1528	set success 0
1529	set nm $errorInfo
1530	return [list $success $nm $curenc $txt]
1531	}
1532	fconfigure $fid -encoding $curenc
1533	while {[eof $fid] != 1} {
1534	gets $fid fln
1535	# replace tabs
1536	regsub -all {\t} $fln " " fln
1537	incr flnn
1538	if {[regexp {^\sencoding\s+(\S+)\s$} $fln encln enc]} {
1539	if {$encspc} {
1540	set success 0
1541	set nm "$pth \[$flnn\] -- multiple encoding commands in file"
1542	break
1543	}
1544	set encspc 1
1545	set rxp "\\s+($enc)\\s+"
1546	set validenc [regexp -nocase $rxp $xth(encodings) dum curenc]
1547	if {$validenc == 0} {
1548	set success 0
1549	set nm "$pth \[$flnn\] -- unknown encoding -- $enc"
1550	break
1551	}
1552	fconfigure $fid -encoding $curenc
1553	} else {
1554	# if {$encspc == 0} {
1555	# if {[regexp {^\s*[^\#]+} $fln]} {
1556	# set success 0
1557	# set nm "$pth \[$flnn\] -- encoding command expected"
1558	# break
1559	# }
1560	# }
1561	append txt "$fln\n"
1562	}
1563	}
1564	close $fid
1565	return [list $success $nm $curenc $txt]
1566
1567	}
1568
1569
1570	# xth_te_write_file --
1571	#
1572	# return list containing
1573	# {success name}
1574
1575	proc xth_te_write_file {pth enc txt} {
1576
1577	global errorInfo xth
1578
1579	set curenc utf-8
1580	set nm [file tail $pth]
1581	set success 1
1582	if {[catch {set fid [open $pth w]}]} {
1583	set success 0
1584	set nm $errorInfo
1585	return [list $success $nm]
1586	}
1587
1588	fconfigure $fid -encoding $curenc
1589	if {![string equal $xth(prj,name) svxedit]} {
1590	puts $fid "encoding $enc"
1591	}
1592	fconfigure $fid -encoding $enc
1593	puts -nonewline $fid $txt
1594	close $fid
1595	return [list $success $nm]
1596
1597	}
1598
1599
1600	proc xth_te_destroy_file {} {
1601
1602	global xth
1603
1604	if {$xth(te,fcurr) >= 0} {
1605
1606
1607	# delete file from list and listbox and destroy windows
1608	set tempcurr $xth(te,fcurr)
1609	set cfid [lindex $xth(te,flist) $tempcurr]
1610	pack forget $xth(te,$cfid,frame)
1611	set xth(te,flist) [lreplace $xth(te,flist) $xth(te,fcurr) $xth(te,fcurr)]
1612	$xth(ctrl,te,files).fl.flbox delete $tempcurr
1613	set xth(te,fcurr) -1
1614
1615	# set other window to be active
1616	xth_te_show_file $tempcurr
1617
1618	# destroy variable
1619	unset xth(te,$cfid,name)
1620	unset xth(te,$cfid,path)
1621	unset xth(te,$cfid,newf)
1622	unset xth(te,$cfid,encoding)
1623	unset xth(te,$cfid,frame)
1624	unset xth(te,$cfid,otext)
1625	}
1626
1627	}
1628
1629
1630	proc xth_load_file {fname fline} {
1631	global xth
1632	# now let's open file fname
1633
1634	# check if not open exists
1635	for {set fid 0} {$fid < [llength $xth(te,flist)]} {incr fid} {
1636	if {[string equal $fname $xth(te,[lindex $xth(te,flist) $fid],path)]} {
1637	xth_te_show_file $fid
1638	return 1
1639	}
1640	}
1641
1642	# read the file
1643	xth_status_bar_push te
1644	xth_status_bar_status te "Opening $fname ..."
1645
1646	set fdata [xth_te_read_file $fname]
1647	if {[lindex $fdata 0] == 0} {
1648	MessageDlg $xth(gui,message) -parent $xth(gui,main) \
1649	-icon error -type ok \
1650	-message [lindex $fdata 1] \
1651	-font $xth(gui,lfont)
1652	xth_status_bar_pop te
1653	return 0
1654	}
1655
1656	# show the file
1657	xth_te_create_file
1658	set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
1659	set xth(te,$cfid,name) [lindex $fdata 1]
1660	set xth(te,$cfid,path) $fname
1661	set xth(te,$cfid,newf) 0
1662	set xth(te,$cfid,encoding) [lindex $fdata 2]
1663	$xth(ctrl,te,files).ef.cel configure -text [lindex $fdata 2]
1664	regsub -all {\s*$} [lindex $fdata 3] "" ftext
1665	xth_te_insert_text $xth(te,$cfid,frame).txt "$ftext\n"
1666	set xth(te,$cfid,otext) [$xth(te,$cfid,frame).txt get 1.0 end]
1667	xth_te_show_file $xth(te,fcurr)
1668	$xth(te,$cfid,frame).txt mark set insert "$fline.0"
1669	$xth(te,$cfid,frame).txt see insert
1670
1671	xth_status_bar_pop te
1672	return 1
1673	}
1674
1675	proc xth_te_open_file {dialogid fname fline} {
1676
1677	global xth
1678
1679	if {$dialogid} {
1680	set fname [tk_getOpenFile -filetypes $xth(app,te,filetypes) \
1681	-parent $xth(gui,main) \
1682	-initialfile $fname -defaultextension $xth(app,te,fileext)]
1683	}
1684
1685	if {[string length $fname] == 0} {
1686	return 0
1687	}
1688
1689	return [xth_load_file $fname $fline]
1690	}
1691
1692	proc xth_te_before_close_file {cfid btns} {
1693	global xth
1694	set ftext [$xth(te,$cfid,frame).txt get 1.0 end]
1695	if {[string compare $xth(te,$cfid,otext) $ftext] != 0} {
1696	set wtd [MessageDlg $xth(gui,message) -parent $xth(gui,main) \
1697	-icon question -type $btns\
1698	-message "File $xth(te,$cfid,path) is not saved. Save it now?" \
1699	-font $xth(gui,lfont)]
1700	switch $wtd {
1701	0 {
1702	if {[xth_te_save_file 0 $cfid] == 0} {
1703	return 0
1704	}
1705	}
1706	1 {}
1707	default {return 0}
1708	}
1709	}
1710	return 1
1711	}
1712
1713	proc xth_te_close_file {} {
1714
1715	global xth
1716
1717	if {$xth(te,fcurr) < 0} {
1718	return
1719	}
1720	set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
1721	if {[xth_te_before_close_file $cfid yesnocancel]} {
1722	xth_te_destroy_file
1723	return 1
1724	} else {
1725	return 0
1726	}
1727
1728	}
1729
1730	proc xth_te_save_file {dialogid cfid} {
1731
1732	global xth
1733
1734	if {[llength $xth(te,flist)] == 0} {
1735	return 0
1736	}
1737
1738	set fid [lsearch -exact $xth(te,flist) $cfid]
1739	if {$fid == -1} {
1740	return 0
1741	}
1742
1743	set cfid [lindex $xth(te,flist) $fid]
1744
1745	# let's check if we need to save
1746	set ftext [$xth(te,$cfid,frame).txt get 1.0 end]
1747	if {! $dialogid} {
1748	if {[string compare $xth(te,$cfid,otext) $ftext] == 0} {
1749	return 1
1750	}
1751	}
1752
1753	xth_status_bar_push te
1754
1755	if {$xth(te,$cfid,newf)} {
1756	set dialogid 1
1757	}
1758
1759	set fname $xth(te,$cfid,path)
1760	set ofname $fname
1761	if {$dialogid} {
1762	set fname [tk_getSaveFile -filetypes $xth(app,te,filetypes) \
1763	-parent $xth(gui,main) \
1764	-initialfile [file tail $fname] -initialdir [file dirname $fname] \
1765	-defaultextension $xth(app,te,fileext)]
1766	}
1767
1768	if {[string length $fname] == 0} {
1769	return 0
1770	}
1771
1772	# save the file
1773	xth_status_bar_status te "Saving $fname ..."
1774	set fdata [xth_te_write_file $fname $xth(te,$cfid,encoding) $ftext]
1775	if {[lindex $fdata 0] == 0} {
1776	MessageDlg $xth(gui,message) -parent $xth(gui,main) \
1777	-icon error -type ok \
1778	-message [lindex $fdata 1] \
1779	-font $xth(gui,lfont)
1780	xth_status_bar_pop te
1781	return
1782	}
1783
1784	set xth(te,$cfid,otext) $ftext
1785	set xth(te,$cfid,newf) 0
1786
1787	# if SaveAs, then redisplay the file
1788	if {$dialogid} {
1789	if {[string compare $ofname $fname] != 0} {
1790	set xth(te,$cfid,name) [lindex $fdata 1]
1791	set xth(te,$cfid,path) $fname
1792	xth_te_show_file $fid
1793	}
1794	}
1795
1796	xth_status_bar_pop te
1797	return 1
1798
1799	}
1800
1801	proc xth_te_save_all {} {
1802
1803	global xth
1804	set ocur $xth(te,fcurr)
1805	foreach cfid $xth(te,flist) {
1806	xth_te_save_file 0 $cfid
1807	}
1808	xth_te_show_file $ocur
1809
1810	}
1811
1812
1813	proc xth_te_update_position {W} {
1814	global xth
1815	$xth(gui,te).sf.pbar configure -text [$W index insert]
1816	}
1817
1818
1819	proc xth_te_text_select_all {txt} {
1820	$txt tag add sel 1.0 end
1821	}
1822
1823
1824	proc xth_te_select_all {} {
1825	global xth
1826	if {$xth(te,fcurr) > -1} {
1827	set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
1828	$xth(te,$cfid,frame).txt tag add sel 1.0 end
1829	}
1830	}
1831
1832
1833	$xth(te,menu,file) add command -label "New" -command xth_te_create_file \
1834	-font $xth(gui,lfont) -underline 0
1835	$xth(te,menu,file) add command -label "Open" -underline 0 \
1836	-accelerator "$xth(gui,controlk)-o" \
1837	-font $xth(gui,lfont) -command {xth_te_open_file 1 {} 1}
1838	$xth(te,menu,file) add command -label "Save" -underline 0 \
1839	-accelerator "$xth(gui,controlk)-s" -state disabled \
1840	-font $xth(gui,lfont) -command {
1841	if {$xth(te,fcurr) >= 0} {
1842	xth_te_save_file 0 [lindex $xth(te,flist) $xth(te,fcurr)]
1843	}
1844	}
1845	$xth(te,menu,file) add command -label "Save as" -underline 5 \
1846	-font $xth(gui,lfont) -state disabled -command {
1847	if {$xth(te,fcurr) >= 0} {
1848	xth_te_save_file 1 [lindex $xth(te,flist) $xth(te,fcurr)]
1849	}
1850	}
1851	$xth(te,menu,file) add command -label "Save all" -underline 6 \
1852	-font $xth(gui,lfont) -state disabled -command xth_te_save_all
1853	$xth(te,menu,file) add command -state disabled -label "Close" -underline 0 \
1854	-accelerator "$xth(gui,controlk)-w" \
1855	-font $xth(gui,lfont) \
1856	-command "xth_te_close_file"
1857
1858	$xth(te,menu,file) add separator
1859	$xth(te,menu,file) add command -state disabled -label "Next" \
1860	-accelerator "$xth(gui,controlk)-n" \
1861	-font $xth(gui,lfont) -command "xth_te_switch_file 1" -underline 1
1862	$xth(te,menu,file) add command -state disabled -label "Previous" \
1863	-accelerator "$xth(gui,controlk)-p" \
1864	-font $xth(gui,lfont) -command "xth_te_switch_file -1" -underline 0
1865
1866	set xth(te,menu,edit) $xth(te,menu).edit
1867	menu $xth(te,menu,edit) -tearoff 0
1868	$xth(te,menu) add cascade -label "Edit" -state disabled \
1869	-font $xth(gui,lfont) -menu $xth(te,menu,edit) -underline 0
1870	$xth(te,menu,edit) add command -label "Select all" -font $xth(gui,lfont) \
1871	-accelerator "$xth(gui,controlk)-a" -command "xth_te_select_all"
1872	$xth(te,menu,edit) add command -label "Auto indent" -font $xth(gui,lfont) \
1873	-command "xth_te_auto_indent" -accelerator "$xth(gui,controlk)-i"
1874	$xth(te,menu,edit) add separator
1875	$xth(te,menu,edit) add command -label "Cut" -font $xth(gui,lfont) \
1876	-accelerator "$xth(gui,controlk)-x" -command "xth_app_clipboard cut"
1877	$xth(te,menu,edit) add command -label "Copy" -font $xth(gui,lfont) \
1878	-accelerator "$xth(gui,controlk)-c" -command "xth_app_clipboard copy"
1879	$xth(te,menu,edit) add command -label "Paste" -font $xth(gui,lfont) \
1880	-accelerator "$xth(gui,controlk)-v" -command "xth_app_clipboard paste"
1881
1882	proc xth_te_get_indent {w i cilc} {
1883
1884	global xth
1885	set indls ""
1886	set cmdls ""
1887	set cmd0s ""
1888	set cmdl 0
1889	regexp {(\d+)\.} $i dum cln
1890	set line0 [$w get $cln.0 $cln.end]
1891	regexp {\S+} $line0 cmd0s
1892	if {[info exists xth(cmd,$cmd0s)]} {
1893	set cmd0 $xth(cmd,$cmd0s)
1894	} else {
1895	set cmd0 0
1896	}
1897	set sln [expr $cln - 1]
1898	set line1 [$w get $sln.0 $sln.end]
1899	set linel $line1
1900	set hasl 0
1901	set escan 0
1902	while {($sln > 1) && (! $hasl)} {
1903	incr sln -1
1904	if {[regexp {\S} $linel]} {
1905	set cline [$w get $sln.0 $sln.end]
1906	if {[regexp {\\\s*$} $cline]} {
1907	set linel $cline
1908	} else {
1909	set hasl 1
1910	}
1911	} else {
1912	set linel [$w get $sln.0 $sln.end]
1913	}
1914	}
1915	regexp {\S+} $linel cmdls
1916	if {[info exists xth(cmd,$cmdls)]} {
1917	set cmdl $xth(cmd,$cmdls)
1918	set endcmdls $xth(endcmd,$cmdls)
1919	} else {
1920	set cmdl 0
1921	}
1922	regexp {^\s+} $linel indls
1923	set indl [string length $indls]
1924	set bsl1 [regexp {\\\s*$} $line1]
1925
1926	# preskenuje prikazy nad
1927	#puts "cilc \|$cilc\|\nindl \|$indl\|\ncmd0 \|$cmd0\|\ncmd0s \|$cmd0s\|\ncmdl \|$cmdl\|\ncmdls \|$cmdls\|\n"
1928	if {$cmdl == 1} {
1929	# puts "$cln. cilc \|$cilc\|"
1930	set cmdcomct 0
1931	set cmdcomctfi 1
1932	set enddetect 0
1933	set set_cmd_counts {
1934	regexp {\S+} $slns cmdcomx
1935	# puts "$cmdls ?? $cmdcomx"
1936	if {[string compare $endcmdls $cmdcomx] == 0} {
1937	set endscan 1
1938	set enddetect 1
1939	} elseif {[string compare $cmdls $cmdcomx] == 0} {
1940	if {! $cmdcomctfi} {
1941	if {$cmdcomct} {
1942	set endscan 1
1943	}
1944	incr cmdcomct
1945	} else {
1946	set cmdcomctfi 0
1947	}
1948	}
1949	}
1950	set sln [expr $cln - 1]
1951	set slns $line1
1952	set endscan 0
1953	while {($sln > 1) && (!$endscan)} {
1954	incr sln -1
1955	if {[regexp {\S} $slns]} {
1956	set clns [$w get $sln.0 $sln.end]
1957	if {[regexp {(.)\\\s$} $clns dum vlns]} {
1958	set slns "$vlns$slns"
1959	} else {
1960	eval $set_cmd_counts
1961	set slns $clns
1962	}
1963	} else {
1964	set slns [$w get $sln.0 $sln.end]
1965	}
1966	}
1967	if {!$enddetect} {
1968	eval $set_cmd_counts
1969	}
1970	# puts $cmdcomct
1971	if {$cmdcomct > 0} {
1972	set cmdl 0
1973	}
1974	}
1975	# koniec scanovania
1976
1977	if {$bsl1} {
1978	set ind [expr $indl + 2 * $xth(gui,etabsize)]
1979	} else {
1980	set ind $indl
1981	if {$cmdl > 0} {
1982	incr ind $xth(gui,etabsize)
1983	}
1984	if {$cilc && ($cmd0 < 0)} {
1985	incr ind -$xth(gui,etabsize)
1986	}
1987	}
1988
1989	if {$ind > 0} {
1990	return [format %$ind\s " "]
1991	} else {
1992	return ""
1993	}
1994	}
1995
1996	proc xth_te_auto_indent {} {
1997
1998	global xth
1999	if {$xth(te,fcurr) < 0} {
2000	return
2001	}
2002	set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
2003	set W $xth(te,$cfid,frame).txt
2004	set rngs [$W tag ranges sel]
2005	set fln 1
2006	set tln -1
2007	regexp {(\d+)\.} [lindex $rngs 0] dum fln
2008	regexp {(\d+)\.} [lindex $rngs 1] dum tln
2009	xth_status_bar_push te
2010	for {set cln $fln} {$cln < $tln} {incr cln} {
2011	xth_status_bar_status te "Processing line $cln ..."
2012	$W see $cln.0
2013	set spcs ""
2014	regexp {^\s+} [$W get $cln.0 $cln.end] spcs
2015	set spcsc [string length $spcs]
2016	set indct [string length [xth_te_get_indent $W $cln.0 1]]
2017	if {$spcsc == $indct} {
2018	} elseif {$spcsc > $indct} {
2019	$W delete $cln.0 $cln.[expr $spcsc - $indct]
2020	} elseif {$spcsc < $indct} {
2021	$W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
2022	}
2023	}
2024	$W see insert
2025	# $W tag remove sel 1.0 end
2026	xth_status_bar_pop te
2027	}
2028
2029
2030	proc xth_te_text_auto_indent {W} {
2031
2032	set rngs [$W tag ranges sel]
2033	set fln 1
2034	set tln -1
2035	regexp {(\d+)\.} [lindex $rngs 0] dum fln
2036	regexp {(\d+)\.} [lindex $rngs 1] dum tln
2037	for {set cln $fln} {$cln < $tln} {incr cln} {
2038	$W see $cln.0
2039	set spcs ""
2040	regexp {^\s+} [$W get $cln.0 $cln.end] spcs
2041	set spcsc [string length $spcs]
2042	set indct [string length [xth_te_get_indent $W $cln.0 1]]
2043	if {$spcsc == $indct} {
2044	} elseif {$spcsc > $indct} {
2045	$W delete $cln.0 $cln.[expr $spcsc - $indct]
2046	} elseif {$spcsc < $indct} {
2047	$W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
2048	}
2049	}
2050	$W see insert
2051
2052	}
2053
2054
2055
2056
2057
2058
2059
2060	proc xth_te_sdata_scan {} {
2061
2062	global xth
2063	if {$xth(te,fcurr) < 0} {
2064	return [list [expr 2 * $xth(gui,etabsize)] {from to compass clino tape}]
2065	}
2066
2067	set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
2068
2069	# let's find the index
2070	set seli [$w tag ranges sel]
2071	if {[llength $seli] > 0} {
2072	set i [lindex $seli 0]
2073	} else {
2074	set i [$w index insert]
2075	}
2076
2077	regexp {(\d+)\.} $i dum cln
2078	incr cln
2079	set i [$w index $cln.0]
2080	regexp {(\d+)\.} $i dum cln
2081
2082	set dind [format \x25[expr 2 * $xth(gui,etabsize)]s " "]
2083	set dqts {from to compass clino tape}
2084	set scan_data {
2085	if {[regexp {(\s)data\s+\w+\s+(.)} $slns dum dind dqts]} {
2086	set endscan 1
2087	}
2088	}
2089	set sln $cln
2090	set slns ""
2091	set endscan 0
2092	while {($sln > 1) && (!$endscan)} {
2093	incr sln -1
2094	if {[regexp {\S} $slns]} {
2095	set clns [$w get $sln.0 $sln.end]
2096	if {[regexp {(.)\\\s$} $clns dum vlns]} {
2097	set slns "$vlns$slns"
2098	} else {
2099	eval $scan_data
2100	set slns $clns
2101	}
2102	} else {
2103	set slns [$w get $sln.0 $sln.end]
2104	}
2105	}
2106	if {!$endscan} {
2107	eval $scan_data
2108	}
2109
2110	return [list [string length $dind] $dqts]
2111	}
2112
2113
2114	proc xth_te_sdata_buid {qts indc} {
2115
2116	global xth
2117	set cf $xth(ctrl,te,sdata).sdf
2118	catch {destroy $cf}
2119	frame $cf
2120	grid $cf -in $xth(ctrl,te,sdata) -column 0 -row 1 -sticky nsew
2121	grid columnconf $cf 0 -weight 0
2122	grid columnconf $cf 1 -weight 1
2123	grid columnconf $cf 2 -weight 0
2124
2125	set nent 0
2126	set invd 0
2127	set sent 0
2128	set grow 0
2129	foreach qtt $qts {
2130	switch $qtt {
2131	newline {
2132	if {(!$invd) && ($nent > 0)} {
2133	frame $cf.nlf
2134	grid columnconf $cf.nlf 0 -weight 1
2135	grid columnconf $cf.nlf 1 -weight 1
2136	Button $cf.nlf.s$grow -text "Start series" -font $xth(gui,lfont)
2137	Button $cf.nlf.b$grow -text "Break series" -font $xth(gui,lfont)
2138	grid $cf.nlf.s$grow -column 0 -row 0 -sticky news
2139	grid $cf.nlf.b$grow -column 1 -row 0 -sticky news
2140	grid $cf.nlf -in $cf -column 0 -columnspan 3 -row $grow \
2141	-sticky news
2142	set xth(te,sdata,invd,ssb) $cf.nlf.s$grow
2143	set xth(te,sdata,invd,bsb) $cf.nlf.b$grow
2144	set xth(te,sdata,invd,ent) $nent
2145	set invd 1
2146	incr grow
2147	}
2148	}
2149	default {
2150	# zistime typ
2151	if {[info exists xth(datafmt,$qtt,format)]} {
2152	set tqtt $qtt
2153	} else {
2154	set tqtt "unknown"
2155	}
2156	set xth(te,sdata,$nent,qtt) $tqtt
2157	set xth(te,sdata,$nent,format) $xth(datafmt,$tqtt,format)
2158	set xth(te,sdata,$nent,cvalue) ""
2159	set xth(te,sdata,$nent,special) $xth(datafmt,$tqtt,special)
2160	set xth(te,sdata,$nent,de) $cf.de$grow
2161	set xth(te,sdata,$nent,fe) $cf.fe$grow
2162	set xth(te,sdata,$nent,nextde) $cf.de$grow
2163	set xth(te,sdata,$nent,nextvde) $cf.de$grow
2164	Label $cf.l$grow -text $qtt -anchor e -font $xth(gui,lfont)
2165	Entry $cf.de$grow -font $xth(gui,lfont) \
2166	-textvariable xth(te,sdata,$nent,cvalue)
2167	Entry $cf.fe$grow -font $xth(gui,lfont) -width 6 \
2168	-textvariable xth(te,sdata,$nent,format)
2169	bind $cf.de$grow <<xthFocusTo>> "focus $cf.de$grow; $cf.de$grow icursor 0; $cf.de$grow selection range 0 end"
2170	bind $cf.de$grow <Key-Tab> "event generate \$xth(te,sdata,$nent,nextde) <<xthFocusTo>> -when tail"
2171	bind $cf.de$grow <Key-Return> "event generate \$xth(te,sdata,$nent,nextvde) <<xthFocusTo>> -when tail"
2172	bind $cf.de$grow <Key-KP_Enter> "event generate \$xth(te,sdata,$nent,nextvde) <<xthFocusTo>> -when tail"
2173	grid $cf.l$grow -in $cf -column 0 -row $grow -sticky news
2174	grid $cf.de$grow -in $cf -column 1 -row $grow -sticky news
2175	grid $cf.fe$grow -in $cf -column 2 -row $grow -sticky news
2176	incr grow
2177	incr nent
2178	}
2179	}
2180	}
2181
2182	set xth(te,sdata,nent) $nent
2183	set xth(te,sdata,indc) $indc
2184	set xth(te,sdata,invd) $invd
2185
2186	xth_te_sdata_bind
2187	}
2188
2189
2190	proc xth_te_sdata_incr_station {ss} {
2191	set rv $ss
2192	if {[regexp {\d+$} $ss xx]} {
2193	regsub {\d+$} $ss [expr $xx + 1] rv
2194	return $rv
2195	}
2196	return $rv
2197	}
2198
2199	proc xth_te_sdata_incr {} {
2200
2201	global xth
2202	if {$xth(te,sdata,incr,station) != -1} {
2203	set xth(te,sdata,$xth(te,sdata,incr,station),cvalue) \
2204	[xth_te_sdata_incr_station \
2205	$xth(te,sdata,$xth(te,sdata,incr,station),cvalue)]
2206	} else {
2207	if {$xth(te,sdata,incr,from) != -1} {
2208	if {$xth(te,sdata,incr,to) != -1} {
2209	set xth(te,sdata,$xth(te,sdata,incr,from),cvalue) \
2210	$xth(te,sdata,$xth(te,sdata,incr,to),cvalue)
2211	}
2212	}
2213	if {$xth(te,sdata,incr,to) != -1} {
2214	set xth(te,sdata,$xth(te,sdata,incr,to),cvalue) \
2215	[xth_te_sdata_incr_station \
2216	$xth(te,sdata,$xth(te,sdata,incr,to),cvalue)]
2217	}
2218	}
2219
2220	}
2221
2222
2223	proc xth_te_sdata_bind {} {
2224
2225	global xth
2226
2227	if {! [info exists xth(te,sdata,nent)]} {
2228	return
2229	} elseif {$xth(te,sdata,nent) < 1} {
2230	return
2231	}
2232
2233	set xth(te,sdata,incr,station) -1
2234	set xth(te,sdata,incr,from) -1
2235	set xth(te,sdata,incr,to) -1
2236	for {set i 0} {$i < $xth(te,sdata,nent)} {incr i} {
2237	if {$i != [expr $xth(te,sdata,nent) - 1]} {
2238	set xth(te,sdata,$i,nextde) $xth(te,sdata,[expr $i + 1],de)
2239	set xth(te,sdata,$i,nextvde) $xth(te,sdata,[expr $i + 1],de)
2240	} else {
2241	set xth(te,sdata,$i,nextde) $xth(te,sdata,0,de)
2242	set xth(te,sdata,$i,nextvde) $xth(te,sdata,0,de)
2243	}
2244	set sx [lsearch {from to station} $xth(te,sdata,$i,qtt)]
2245	if {$sx != -1} {
2246	set xth(te,sdata,incr,[lindex {from to station} $sx]) $i
2247	}
2248	}
2249
2250	if {! $xth(te,sdata,es)} {
2251	for {set i 0} {$i < $xth(te,sdata,nent)} {incr i} {
2252	if {[lsearch {station from to} $xth(te,sdata,$i,qtt)] == -1} {
2253	for {set j 1} {$j < $xth(te,sdata,nent)} {incr j} {
2254	set jj [expr ($i + $j) % $xth(te,sdata,nent)]
2255	if {[lsearch {station from to} $xth(te,sdata,$jj,qtt)] == -1} {
2256	set xth(te,sdata,$i,nextvde) $xth(te,sdata,$jj,de)
2257	set j $xth(te,sdata,nent)
2258	}
2259	}
2260	}
2261	}
2262	}
2263
2264	# now let's bind enter keys
2265	if {$xth(te,sdata,invd)} {
2266	set wtw1 ""
2267	set wtw2 ""
2268	set clw ""
2269	for {set iet 0} {$iet < $xth(te,sdata,nent)} {incr iet} {
2270	if {$iet < $xth(te,sdata,invd,ent)} {
2271	append wtw1 " \$xth(te,sdata,$iet,cvalue)"
2272	} else {
2273	append wtw2 " \$xth(te,sdata,$iet,cvalue)"
2274	}
2275	if {[lsearch {from to station} $xth(te,sdata,$iet,qtt)] == -1} {
2276	append clw "set xth(te,sdata,$iet,cvalue) \"\"\n"
2277	}
2278	}
2279	set enter_cmd "xth_te_sdata_insert \"$wtw2\" 2 insert\nxth_te_sdata_insert \"$wtw1\" 1 insert\nxth_te_sdata_incr\n$clw"
2280	append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
2281	bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <Return> $enter_cmd
2282	bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <KP_Enter> $enter_cmd
2283
2284	set enter_cmd "xth_te_sdata_insert \"$wtw1\" 1 insert\nxth_te_sdata_incr\n$clw"
2285	append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
2286	$xth(te,sdata,invd,ssb) configure -command $enter_cmd
2287
2288	set enter_cmd "xth_te_sdata_insert \"break\" 3 insert\n$clw"
2289	append enter_cmd "event generate \$xth(te,sdata,0,de) <<xthFocusTo>> -when tail"
2290	$xth(te,sdata,invd,bsb) configure -command $enter_cmd
2291
2292	} else {
2293	set wtw ""
2294	set clw ""
2295	for {set iet 0} {$iet < $xth(te,sdata,nent)} {incr iet} {
2296	append wtw " \$xth(te,sdata,$iet,cvalue)"
2297	if {[lsearch {from to station} $xth(te,sdata,$iet,qtt)] == -1} {
2298	append clw "set xth(te,sdata,$iet,cvalue) \"\"\n"
2299	}
2300	}
2301	set enter_cmd "xth_te_sdata_insert \"$wtw\" 0 insert\nxth_te_sdata_incr\n$clw"
2302	append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
2303	bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <Return> $enter_cmd
2304	bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <KP_Enter> $enter_cmd
2305	}
2306	}
2307
2308
2309	$xth(ctrl,te,sdata).sfb configure -command {
2310	set dil [xth_te_sdata_scan]
2311	xth_te_sdata_buid [lindex $dil 1] [lindex $dil 0]
2312	}
2313
2314
2315	$xth(ctrl,te,sdata).sfs configure -command xth_te_sdata_bind
2316
2317
2318	proc xth_te_sdata_insert {data invd iidx} {
2319
2320	global xth
2321	if {$xth(te,fcurr) < 0} {
2322	return
2323	}
2324
2325	if {! [info exists xth(te,sdata,nent)]} {
2326	return
2327	} elseif {$xth(te,sdata,nent) < 1} {
2328	return
2329	}
2330
2331	set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
2332	set xth(me,sdata,err_notenought) 0
2333
2334	set err 0
2335	if {$xth(gui,etabsize) > 0} {
2336	set tabspc [format \x25$xth(gui,etabsize)s " "]
2337	} else {
2338	set tabspc " "
2339	}
2340	set sent 0
2341	set eent $xth(te,sdata,nent)
2342	switch $invd {
2343	1 {
2344	set eent $xth(te,sdata,invd,ent)
2345	}
2346	2 {
2347	set sent $xth(te,sdata,invd,ent)
2348	}
2349	}
2350
2351	set txt ""
2352	set fst ""
2353	set iet $sent
2354	set tmp $data
2355	set ldata {}
2356	while {[string length $tmp] > 0} {
2357	if {[regexp {\S+} $tmp itm]} {
2358	lappend ldata $itm
2359	}
2360	regsub {\s\S\s*} $tmp {} tmp
2361	}
2362	if {([llength $ldata] < $eent) && (!$xth(te,sdata,invd))} {
2363	set xth(me,sdata,err_notenought) 1
2364	}
2365	foreach itm $ldata {
2366	set postwrt 0
2367	set tobreak 0
2368	if {$iet < $eent} {
2369	if {[lsearch -exact $xth(te,sdata,$iet,special) $itm] != -1} {
2370	set postwrt 1
2371	} else {
2372	set curfmt $xth(te,sdata,$iet,format)
2373	set extfmt 0
2374	if {[regsub {fx(\s*)$} $curfmt {f\1} curfmt]} {
2375	set extfmt 1
2376	}
2377	puts "$itm -> $fst\x25$curfmt"
2378	if {[catch {append txt [format "$fst\x25$curfmt" $itm]}]} {
2379	set postwrt 1
2380	puts "error"
2381	set err 1
2382	} elseif {$extfmt == 1} {
2383	if {[regexp {\.?0+\s*$} $txt txtextend]} {
2384	set teel [string length $txtextend]
2385	regsub {\.?0+\s*$} $txt [format \x25[expr $teel]s " "] txt
2386	}
2387	}
2388	}
2389	} else {
2390	# ak je dlhsie, uz neformatuj
2391	puts $data
2392	set unfdata $data
2393	for {set ufi 0} {$ufi < $eent} {incr ufi} {
2394	regsub {^\s\S+\s} $unfdata "" unfdata
2395	}
2396	append txt $fst $unfdata
2397	# append txt [format $fst\x25$xth(datafmt,unknown,format) $itm]
2398	# set err 1
2399	set tobreak 1
2400	}
2401
2402
2403	if {$postwrt == 1} {
2404	if {[regexp {(\d+)\.?(\d*)} $xth(te,sdata,$iet,format) dum nfln nzadc]} {
2405	set nitm $itm
2406	if {[string length nzadc] > 0} {
2407	append nitm [format \x25[expr $nzadc + 1]s " "]
2408	}
2409	append txt [format $fst\x25[expr $nfln]s $nitm]
2410	} else {
2411	append txt [format $fst\x25$xth(datafmt,unknown,format) $itm]
2412	}
2413	}
2414
2415	set fst $tabspc
2416	incr iet
2417	if {$tobreak} {
2418	break
2419	}
2420	}
2421
2422	set cind $xth(te,sdata,indc)
2423	if {($invd == 2) && (!$err)} {
2424	if {[regexp {\d+} $xth(te,sdata,0,format) plusindc]} {
2425	incr cind [expr $plusindc + 1]
2426	} else {
2427	incr cind [expr 2 * $xth(gui,etabsize)]
2428	}
2429	}
2430
2431	if {($invd == 3) \|\| $err} {
2432	set txt $data
2433	regsub {^\s+} $txt "" txt
2434	regsub {\s+$} $txt "" txt
2435	}
2436
2437	if {$cind > 0} {
2438	set txt [format \x25[expr $cind + [string length $txt]]s $txt]
2439	}
2440
2441	if {[string compare $iidx insert] == 0} {
2442	xth_te_insert_text $w "\n$txt"
2443	} else {
2444	$w insert $iidx $txt
2445	}
2446	return $err
2447
2448	}
2449
2450
2451	proc xth_te_sdata_auto_format {} {
2452
2453	global xth
2454	if {$xth(te,fcurr) < 0} {
2455	return
2456	}
2457
2458	if {! [info exists xth(te,sdata,nent)]} {
2459	return
2460	} elseif {$xth(te,sdata,nent) < 1} {
2461	return
2462	}
2463
2464	set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
2465	set s [$w tag ranges sel]
2466	if {[llength $s] < 2} {
2467	return
2468	}
2469
2470	set eline -1
2471	set sline 0
2472	regexp {(\d+)\.} [lindex $s 0] dum sline
2473	regexp {(\d+)\.} [lindex $s 1] dum eline
2474	# $w tag remove sel 1.0 end
2475	set ict 1
2476	for {set cline $sline} {$cline <= $eline} {incr cline} {
2477	set txt [$w get $cline.0 $cline.end]
2478	if {[regexp {\S+} $txt]} {
2479	set orig [$w get $cline.0 $cline.end]
2480	$w delete $cline.0 $cline.end
2481	if {$xth(te,sdata,invd)} {
2482	set formatres [xth_te_sdata_insert $txt $ict $cline.0]
2483	if {$formatres == 0} {
2484	if {$ict == 1} {
2485	set ict 2
2486	} else {
2487	set ict 1
2488	}
2489	} else {
2490	if {[regexp {^\sbreak\s$} $txt]} {
2491	set xth(me,sdata,err_notenought) 0
2492	set ict 1
2493	}
2494	}
2495	} else {
2496	set formatres [xth_te_sdata_insert $txt 0 $cline.0]
2497	}
2498	# an error occured
2499	if {$formatres \|\| $xth(me,sdata,err_notenought)} {
2500	puts "inserting >>$orig<<"
2501	$w delete $cline.0 $cline.end
2502	$w insert $cline.0 $orig
2503	}
2504	}
2505	}
2506	$w see insert
2507	}
2508
2509
2510
2511
2512
2513
2514
2515	$xth(ctrl,te,sdata).taf configure -command xth_te_sdata_auto_format
2516	xth_te_sdata_buid {from to tape compass clino} [expr 2 * $xth(gui,etabsize)]
2517	xth_te_sdata_disable ""
2518
2519
2520
2521
2522
2523
2524
2525	xth_app_finish
2526	xth_app_show [lindex $xth(app,list) 0]
2527
2528	xth_app_clock
2529
2530	encoding system [string tolower $xth(app,sencoding)]
2531	xth_about_hide
2532	wm deiconify $xth(gui,main)
2533	xth_app_normalize
2534	foreach fname $argv {
2535	xth_load_file $fname 1
2536	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format