Tk Text Edit

Check-in [35fd5133a1]
Login
☰Home Timeline Branches Tags Tickets Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add reuse of first opened editor
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:35fd5133a192b258838a5dc2122b16e5a8b0e12a
User & Date: dennis2 2002-12-17 09:31:42
Context
2002-12-17
09:44
Fixed bug with remote loading of http check-in: 6d4090ffa0 user: dennis2 tags: trunk
09:31
Add reuse of first opened editor check-in: 35fd5133a1 user: dennis2 tags: trunk
2002-11-14
20:10
Fixed prompt check-in: 361ee857e8 user: dennis2 tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to CHANGES. 

1
2

3
4
5
6
7
8
9

Version 0.9.11 released <tbd>


* Changed default font in textsh to Courier
* Fixed prompt in textsh
* Delimiters in speedbuttonbar

Version 0.9.10 released 01-03-03

* Moved helpfiles to separate directory



>








1
2
3
4
5
6
7
8
9
10

Version 0.9.11 released <tbd>

* Add possibility to reuse allready opened editor
* Changed default font in textsh to Courier
* Fixed prompt in textsh
* Delimiters in speedbuttonbar

Version 0.9.10 released 01-03-03

* Moved helpfiles to separate directory

Changes to lib/edit.tcl. 

1
2
3
4














5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
..
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146






147


148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190

191
192
193
194
195
196
197
...
202
203
204
205
206
207
208


209
210
211
212
213
214
215
...
260
261
262
263
264
265
266
267
268

269
270
271
272
273
274
275
276
277












































278
279
280
281
282
283
284


285
286
287
288

289
290
291
292
293

294
295

296
297



298
299
300
301
302
303
304
305























306
307
308
309

310
311
312
313
314
315
316

set debug_messages 0
set tcl_traceExec 0

set prgname "Tcl TextEdit 0.9.10"















#?-About
#?%2TCL TextEdit v0.9.x%
#?
#? %ptte.gif%
#? 
#? Created by Dennis Ehlin
#? http://sourceforge.net/projects/tcltextedit/
#? 
#?
#? Related topics: %lDisclaimer% %lPromotion% 
#?
#?-Promotion
#?
#? Please feel free to use this logo at your homepage
#?
#? %pttenow.gif%
#?
#? Just copy the image "ttenow.gif " and insert the html code below where you want it
#? The image is included in the distribution. 
#?
#? <A HREF="http://sourceforge.net/projects/tcltextedit/">
#? <IMG SRC="ttenow.gif" BORDER="0"
#? ALT="Get TCL TextEdit now!!"></A>
#?
#?-Disclaimer
#?
#?%2TCL TextEdit v0.9.x%
#?
................................................................................
#?
#? If you have any problems or if you have any ideas, dont hesitate to
#? Send me a mail message.
#? 
#? You can find my mail address here %lAbout%
#?

proc bgerror {s} {
	global rr debug_messages errorInfo errorCode installdir
	set info $errorInfo

	set ou .ou
	catch {destroy $ou}
	toplevel $ou
	wm title $ou "Message"
	wm resizable $ou false false
	wm protocol  $ou WM_DELETE_WINDOW "set rr 1"
	set rr 0

	if {[info exist installdir]} {
		if {[file exist [file join $installdir/stop.gif] ]} {
			image create photo warn -file [file join $installdir/stop.gif]
			label $ou.img -image warn -borderwidth 0
			pack $ou.img -side left
		} 
	}

	frame $ou.f 

	label $ou.f.label -text "$s !"
	button $ou.f.ok -text "Ok"       -command "set rr 1" -width 5 -borderwidth 1
	pack $ou.f.label
	pack $ou.f.ok  

	if {$debug_messages>0} {
		label $ou.f.d1 -text "Info: $info" -foreground red
		label $ou.f.d2 -text "Code: $errorCode" -foreground blue
		pack  $ou.f.d2 $ou.f.d1
	}

	pack $ou.f -side left
	bind $ou <Escape> "set rr 1"
	bind $ou <Return> "set rr 1"
	grab $ou
	focus $ou.f.ok
	if {[info exist powin]} { 
		powin $ou
	}
	vwait rr
	destroy $ou
}


#------------------------------------------------------------------------------+

proc setup {} {
	global env installdir tk_version tcl_version c home numw tcl_platform argv0 helpdir

	if {$tcl_platform(platform)!="windows"} {

		if {![info exist env(DISPLAY)]} {
			puts stdout "Are you sure yo're running X ?"
			exit
		}
	}

	#Check tk/tcl versions
	if {$tk_version<8} { 
		puts stdout "You need to upgrade to tk/tcl 8.0 or higer!"
		exit
	}
	if {$tcl_version<8} { 
		puts stdout "You need to upgrade to tk/tcl 8.0 or higer!"
		exit
	}

	set cfg::file "$home/rc"
	cfg::load

	# Load images
	image create photo warn -file [file join $installdir/stop.gif]
	image create photo i_folder -file [file join $installdir/folder.gif]
	image create photo i_openfile -file [file join $installdir/openfile.gif]
	image create photo i_savedfile -file [file join $installdir/savedfile.gif]
	image create photo i_file -file [file join $installdir/file.gif]
	image create photo bar -file [file join $installdir/bar.gif]

	tk_setPalette background $c(color-background)
}


#------------------------------------------------------------------------------+










if {$tcl_platform(platform)!="windows"} {
	#Unix
	set installdir [file dirname $argv0]
	set home "$env(HOME)/.tcltextedit"
	set helpdir "$installdir/help"

	if {![file exists $home]} {
		file mkdir $home
	}

} else {
	#Windows
	set installdir [file dirname $argv0]
	set home $installdir
	set helpdir "$installdir/help"
}

set numw 99

set op [pwd]
cd $installdir
source cfg.tcl
cd $op

setup

for {set i 1} {$i <100 } {incr i } {
	set window($i,name) "Untitled #$i"
	set window($i,info) ""
	set window($i,change) "0"
	set window($i,pos) "1.0"
	set window($i,echange) "0"
	set window($i,extra) ""
	set window($i,temp) ""
}
set i 100
set window($i,name) "ClipBoard"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
set window($i,extra) ""
set window($i,temp) "NoFile"


set i 200
set window($i,name) "FileList"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
................................................................................
set window($i,name) "Help"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
set window($i,extra) ""
set window($i,temp) "NoFile"



set ftypes {
{{All Files}       {*}         }
{{Text Files}      {.txt}      } 
{{TCL Script}      {.tcl}      }
{{C Source}        {.c}        }
{{Pascal Source}   {.pas}      }
................................................................................
source specc.tcl
source gui.tcl
source txt.tcl
source bindings.tcl
source speed.tcl
cd $op




#------------------------------------------------------------------------------+

proc fixname {f} {
	set r ""
	for {set i 0} {$i <[string length $f] } {incr i } {
		set c [string index $f $i]
		if {$c=="\134"} {set c "/"}
		set r "$r$c"
	}












































	return $r
}

#------------------------------------------------------------------------------+

#Check if user supplied anything at the command line



set i 1
set fil [lindex $argv 0]

while {$fil!=""} {

	set fil [fixname $fil]

	set tmp [string toupper $fil]
	if {[string first "HTTP://" $tmp]=="0"} {
		file::Load "http $fil" -force

	} else {
 	       file::Load "file $fil" -force

	}




	set fil [lindex $argv $i]
	incr i
	if {$i>$numw} {set fil ""}
}

if {$i==1} {
	file::NewFile
}
























win::activate 1
win::update
win::status_change


#Set up update procedure for status line
trace variable window w win::status_change

#Focus on text

updaterecent





>
>
>
>
>
>
>
>
>
>
>
>
>
>







|
|












|







 







|
|
|

|
|
|
|
|
|
|

|
|
|
|
|
|
|

|

|
|
|
|

|
|
|
|
|

|
|
|
|
|
|
<
<
|
|






|

|
>
|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|

|
|
|
|
|
|
|

|





>
>
>
>
>
>

>
>

|
|
|
|

|
|
|


|
|
|
|












|
|
|
|
|
|
|









>







 







>
>







 







|

>



|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



<
<
<
<
>
>
|
|

|
>
|

|
|
<
>
|
<
>
|

>
>
>
|
|
<
|

|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
..
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114


115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
...
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349




350
351
352
353
354
355
356
357
358
359
360

361
362

363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410

set debug_messages 0
set tcl_traceExec 0

set prgname "Tcl TextEdit 0.9.10"


#this must be done before tk appname
set first_instance [catch {
        send "ttedit" "ping"
}]

tk appname "ttedit"

proc ping {} {
 return 1
}



#?-About
#?%2TCL TextEdit v0.9.x%
#?
#? %ptte.gif%
#? 
#? Created by Dennis Ehlin
#? mail: hkc141i@tninet.se
#? http://www.user.tninet.se/~hkc141i
#?
#? Related topics: %lDisclaimer% %lPromotion% 
#?
#?-Promotion
#?
#? Please feel free to use this logo at your homepage
#?
#? %pttenow.gif%
#?
#? Just copy the image "ttenow.gif " and insert the html code below where you want it
#? The image is included in the distribution. 
#?
#? <A HREF="http://user.tninet.se/~hkc141i/edit.html">
#? <IMG SRC="ttenow.gif" BORDER="0"
#? ALT="Get TCL TextEdit now!!"></A>
#?
#?-Disclaimer
#?
#?%2TCL TextEdit v0.9.x%
#?
................................................................................
#?
#? If you have any problems or if you have any ideas, dont hesitate to
#? Send me a mail message.
#? 
#? You can find my mail address here %lAbout%
#?

proc xbgerror {s} {
global rr debug_messages errorInfo errorCode installdir
set info $errorInfo

set ou .ou
catch {destroy $ou}
toplevel $ou
wm title $ou "Message"
wm resizable $ou false false
wm protocol  $ou WM_DELETE_WINDOW "set rr 1"
set rr 0

if {[info exist installdir]} {
 if {[file exist [file join $installdir/stop.gif] ]} {
  image create photo warn -file [file join $installdir/stop.gif]
  label $ou.img -image warn -borderwidth 0
  pack $ou.img -side left
 } 
}

frame $ou.f 

label $ou.f.label -text "$s !"
button $ou.f.ok -text "Ok"       -command "set rr 1" -width 5 -borderwidth 1
pack $ou.f.label
pack $ou.f.ok  

if {$debug_messages>0} {
label $ou.f.d1 -text "Info: $info" -foreground red
label $ou.f.d2 -text "Code: $errorCode" -foreground blue
pack  $ou.f.d2 $ou.f.d1
}

pack $ou.f -side left
bind $ou <Escape> "set rr 1"
bind $ou <Return> "set rr 1"
grab $ou
focus $ou.f.ok
if {[info exist powin]} { powin $ou }


vwait rr
destroy $ou
}


#------------------------------------------------------------------------------+

proc setup {} {
global env installdir tk_version tcl_version c home numw tcl_platform argv0 helpdir

if {$tcl_platform(platform)!="windows"} {

if {![info exist env(DISPLAY)]} {
puts stdout "Are you sure yo're running X ?"
exit
}
}

#Check tk/tcl versions
if {$tk_version<8} { 
puts stdout "You need to upgrade to tk/tcl 8.0 or higer!"
exit
}
if {$tcl_version<8} { 
puts stdout "You need to upgrade to tk/tcl 8.0 or higer!"
exit
}

set cfg::file "$home/rc"
cfg::load

# Load images
image create photo warn -file [file join $installdir/stop.gif]
image create photo i_folder -file [file join $installdir/folder.gif]
image create photo i_openfile -file [file join $installdir/openfile.gif]
image create photo i_savedfile -file [file join $installdir/savedfile.gif]
image create photo i_file -file [file join $installdir/file.gif]
image create photo bar -file [file join $installdir/bar.gif]

tk_setPalette background $c(color-background)
}


#------------------------------------------------------------------------------+

proc initialize {} {
global tcl_platform installdir home helpdir window current_window ftypes argv0 env
global prgname debug_messages c numw
global lw  SearchPos  SearchString ReplaceString SearchLen SearchString hold findcase
global SearchDir Text_Insert macro_data macro_rec cu_macro marknums markon undo_active
global last_macro



if {$tcl_platform(platform)!="windows"} {
#Unix
set installdir [file dirname $argv0]
set home "$env(HOME)/.tcltextedit"
set helpdir "$installdir/help"

if {![file exists $home]} {
file mkdir $home
}

} else {
#Windows
set installdir [file dirname $argv0]
set home $installdir
set helpdir "$installdir/help"
}

set numw 99

set op [pwd]
cd $installdir
source cfg.tcl
cd $op

setup

for {set i 1} {$i <100 } {incr i } {
set window($i,name) "Untitled #$i"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
set window($i,extra) ""
set window($i,temp) ""
}
set i 100
set window($i,name) "ClipBoard"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
set window($i,extra) ""
set window($i,temp) "NoFile"


set i 200
set window($i,name) "FileList"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
................................................................................
set window($i,name) "Help"
set window($i,info) ""
set window($i,change) "0"
set window($i,pos) "1.0"
set window($i,echange) "0"
set window($i,extra) ""
set window($i,temp) "NoFile"



set ftypes {
{{All Files}       {*}         }
{{Text Files}      {.txt}      } 
{{TCL Script}      {.tcl}      }
{{C Source}        {.c}        }
{{Pascal Source}   {.pas}      }
................................................................................
source specc.tcl
source gui.tcl
source txt.tcl
source bindings.tcl
source speed.tcl
cd $op

}


#------------------------------------------------------------------------------+

proc fixname {f} {
set r ""
for {set i 0} {$i <[string length $f] } {incr i } {
set c [string index $f $i]
if {$c=="\134"} {set c "/"}
set r "$r$c"
}
return $r
}


#Check if user supplied anything at the command line
proc evalargs {} {
	global argv argv0 numw first_instance
	set i 1
	set fil [lindex $argv 0]

	while {$fil!=""} {
	
		set fil [fixname $fil]

		set tmp [string toupper $fil]
		if {[string first "HTTP://" $tmp]=="0"} {
			set type "http"
		} else {
			set type "file"
		}

		file::Load "$type $fil" -force

		set fil [lindex $argv $i]
		incr i
		if {$i>$numw} {
			set fil ""
		}
	}

	if {$i==1} {
		file::NewFile
	}
}


proc fullpath {f} {

	set r $f

	if {[file pathtype $f] == "relative"} {
		set r [file join [pwd] $f]
	}

	return $r
}





proc evalargs_remote {} {
	global argv argv0 numw first_instance
	set i 1
	set fil [lindex $argv 0]

	while {$fil!=""} {
	
		set fil [fixname $fil]

		set tmp [string toupper $fil]
		if {[string first "HTTP://" $tmp]=="0"} {

			set type "http"
		} else {

			set type "file"
		}

		set fil [fullpath $fil]
		send ttedit "file::Load" "{$type {$fil}}" -force

		set fil [lindex $argv $i]
		incr i

	}

	if {$i==1} {
		send ttedit "file::NewFile"
	}

	
	send ttedit "wm deiconify ."
	send ttedit "raise ."
	send ttedit "focus -force ."
	send ttedit "focus .text"
}




#------------------------------------------------------------------------------+



if { (!$first_instance) && ($argv!="") } {
	evalargs_remote
	exit
}


initialize
evalargs

win::activate 1
win::update
win::status_change


#Set up update procedure for status line
trace variable window w win::status_change

#Focus on text

updaterecent

This page was generated in about 0.005s by Fossil 2.7 [9aa9ba8bd2] 2018-09-22 17:40:11