Tk Text Edit

Check-in [306a766a08]
Login
☰Home Timeline Branches Tags Tickets Wiki

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

Overview
Comment:Add delete from filelist, Add new common dialog: xdialog
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:306a766a080ce632425c75d2d55c05bbe61630c3
User & Date: dennis 2001-01-24 18:39:42
Context
2001-01-24
22:10
Forgot date for release_0_9_9 check-in: 1462d7aed0 user: dennis tags: trunk
18:39
Add delete from filelist, Add new common dialog: xdialog check-in: 306a766a08 user: dennis tags: trunk
2001-01-22
23:11
Various bug fixes check-in: 2dfd3b5084 user: dennis tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to lib/CHANGES. 

1

2
3
4
5
6
7
8



* Various bug fixes on the file list.

Version 0.9.9 released 00-11-

* Logo in File menu
* Possibility to assign icons to speed buttons
* Load/Save/New/Close = new default buttons with icons

|
>








1
2
3
4
5
6
7
8
9

* Add posibility to delete files in filelist window.
* Add new common dialog window.
* Various bug fixes on the file list.

Version 0.9.9 released 00-11-

* Logo in File menu
* Possibility to assign icons to speed buttons
* Load/Save/New/Close = new default buttons with icons

Changes to lib/cfg.tcl. 

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

set c($n) $v
cfg::save
}

proc load {} {
global c cfg::file 
if ![file exists $cfg::file] {
                            bgerror "The configuration file $cfg::file \nis missing creating a new"
                            cfg::checkcfg
                            cfg::save
			    return 0
                           }


set f [open $cfg::file "RDONLY" ]








|








119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

set c($n) $v
cfg::save
}

proc load {} {
global c cfg::file 
if ![file exists $cfg::file] {
                            bgerror "The configuration file $cfg::file \nis missing, a new will be created"
                            cfg::checkcfg
                            cfg::save
			    return 0
                           }


set f [open $cfg::file "RDONLY" ]

Changes to lib/cmds.tcl. 

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39


	if {[info level]!=1} { 
	set result  "[info level -1] --> $args"

	} else { set result "Root --> $args"  }

	if {$debug_messages==2} {
	.logger.text insert end $result
	.logger.text see end
	} else { puts stdout $result}

}
}

proc progress {v max} {








|








25
26
27
28
29
30
31
32
33
34
35
36
37
38
39


	if {[info level]!=1} { 
	set result  "[info level -1] --> $args"

	} else { set result "Root --> $args"  }

	if {$debug_messages==2} {
	.logger.text insert end "$result \n"
	.logger.text see end
	} else { puts stdout $result}

}
}

proc progress {v max} {

Changes to lib/edit.tcl. 

63
64
65
66
67
68
69

70
71
72
73
74
75
76
77
78
79
80
81
82
83

global rr debug_messages errorInfo errorCode installdir
set info $errorInfo

set ou .ou
catch {destroy $ou}
toplevel $ou
wm title $ou "Message"

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 2 -relief raised
  pack $ou.img -side left
 } 
}

frame $ou.f 

label $ou.f.label -text "$s !"








>
|





|








63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

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 !"

Changes to lib/file.tcl. 

616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654

focus .text
}


#=================================== Exit routines ===========================================

proc Ask {s} {
global r
set ou .ou
catch {destroy $ou}
toplevel $ou
wm title $ou "Save ?"
set r "cancel"
frame $ou.f
label $ou.f.label -text "Text in $s has changed\n Do you wish to save it ?"
xbutton $ou.f.yes -text "Yes"       -command "set r yes" -width 5
xbutton $ou.f.cancel -text "Cancel" -command "set r cancel" -width 5
xbutton $ou.f.no  -text "No"        -command "set r no" -width 5
pack $ou.f.label
pack $ou.f.yes $ou.f.no $ou.f.cancel -side left  -padx 10
bind $ou <N> "set r no"
bind $ou <n> "set r no"
bind $ou <Y> "set r yes"
bind $ou <y> "set r yes"
bind $ou <C> "set r cancel"
bind $ou <c> "set r cancel"
bind $ou <Escape> "set r cancel"
label $ou.img -image warn
pack $ou.img $ou.f -side left
powin $ou
vwait r
destroy $ou
return $r
}



proc CloseFile {i} {
global window c








|
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








616
617
618
619
620
621
622
623




624



















625
626
627
628
629
630
631

focus .text
}


#=================================== Exit routines ===========================================

proc Ask {s} {
set r [string tolower [xdialog -icon warn -title "Save ?" -message "Text in $s has changed do you wish to save it ?" -buttons "Yes No Cancel" -default 0]]




if {$r==""} {set r "cancel" }



















return $r
}



proc CloseFile {i} {
global window c

Changes to lib/findreplace.tcl. 

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229


230
231
232
233
234
235
236
237
238
239
240

	if {$SearchDir == "forwards"} {
	 tkTextSetCursor .text "$SearchPos+$leng char"        
	} else { tkTextSetCursor .text $SearchPos }

	.text tag add sel $SearchPos  "$SearchPos+$leng char"

            } else {
	        bgerror "End of document reached"
	       }

  }
}



proc question {} {
global r
set q .question
set r "0"
catch {destroy $q}
toplevel $q
wm title $q "Replace ?"
label $q.label -text "Replace this occurance ?"
frame $q.buttons
button $q.buttons.yes -text "Yes" -command "set r 1" 
button $q.buttons.no  -text "No" -command  "set r 0"
button $q.buttons.abort  -text "Abort" -command  "set r 2"
pack $q.buttons.yes $q.buttons.no $q.buttons.abort -side left
pack $q.label $q.buttons
powin $q
grab $q
vwait r
destroy $q


return $r
}



proc ReplaceIt {n} {
global SearchString SearchDir ReplaceString findcase window current_window rconfirm SearchPos

set SearchPos insert
c 
set window($current_window,echange) 1








|





<
<

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>


<
<








197
198
199
200
201
202
203
204
205
206
207
208
209


210

















211
212
213
214


215
216
217
218
219
220
221

	if {$SearchDir == "forwards"} {
	 tkTextSetCursor .text "$SearchPos+$leng char"        
	} else { tkTextSetCursor .text $SearchPos }

	.text tag add sel $SearchPos  "$SearchPos+$leng char"

            } else {
		xdialog -icon warn -title "Message" -message "End of document reached" -buttons "Ok"
	       }

  }
}



proc question {} {

















set r [xdialog -icon "" -title "XReplace ?" -message "Replace this occurance ?" -buttons "Yes No" -default 0]
if {$r=="Yes"} {set r 1} else {set r 0}
return $r
}



proc ReplaceIt {n} {
global SearchString SearchDir ReplaceString findcase window current_window rconfirm SearchPos

set SearchPos insert
c 
set window($current_window,echange) 1

Changes to lib/flist.tcl. 

112
113
114
115
116
117
118










119
120
121
122
123
124
125
126
127
128
129

	if {$n=="-1"} {
		file::Load "file {$f}" -force
	} else {
		win::activate [lindex [win::names] $n ]
	}
}












}

	set flist_lastfile ""

	set menu .fmnu
	menu $menu -tearoff 0
	$menu add command -label "Open" -command {global flist_file;flist::dclick .flist $flist_lastfile}
	$menu add command -label "Copy" -command {global flist_file;flist::copy $flist_lastfile}
	$menu add separator
	$menu add command -label "Delete"








>
>
>
>
>
>
>
>
>
>



|
|
|
|
|
|
|
|

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

	if {$n=="-1"} {
		file::Load "file {$f}" -force
	} else {
		win::activate [lindex [win::names] $n ]
	}
}

proc delete {file} {

	set r [xdialog -icon warn -title "Delete ?" -message "Are you sure you want to delete \042$file\042 ?" -buttons "Delete Cancel" -default 0 ]

	if {$r=="Delete"} {
		set f  [file join [pwd] $file]
		file delete $f -force
		flist::showdir .flist "[pwd]/*"
	}
}

}

set flist_lastfile ""

set menu .fmnu
menu $menu -tearoff 0
$menu add command -label "Open" -command {global flist_file;flist::dclick .flist $flist_lastfile}
$menu add command -label "Copy" -command {global flist_file;flist::copy $flist_lastfile}
$menu add separator
$menu add command -label "Delete" -command {global flist_file;flist::delete $flist_lastfile}

Changes to lib/gui.tcl. 

51
52
53
54
55
56
57















58
59
60
61
62
63
64
..
73
74
75
76
77
78
79




































































































80
81
82
83
84
85
86

#? otherwise *cancel is returned.
#?
#? %2Example%2
#?
#? Dialog "TestDlg" "Enter your name: "
#?
#? Related topics: %lMacros%

















#--------------------- Widgets & Defaults ----------------------------
option add *Scrollbar.width         12 widgetDefault
option add *Scrollbar.borderWidth   1  widgetDefault

proc xbutton {w args} {
................................................................................
}

proc xmenu {w args} {
global c
c
eval "menu $w $args -tearoff $c(tearoff) -background $c(color-menubg) -foreground $c(color-menutxt) -activebackground $c(color-menuactive) -activeforeground $c(color-menuactivetext) -borderwidth 1 -activeborderwidth 0"
}





































































































#----------------------------------------------------------
proc Dialog {name inputname} {
global r

set dlg .dlg
catch {destroy $dlg}








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







 







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








51
52
53
54
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
..
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

#? otherwise *cancel is returned.
#?
#? %2Example%2
#?
#? Dialog "TestDlg" "Enter your name: "
#?
#? Related topics: %lMacros%
#?
#?-xdialog
#?
#? %2xdialog%
#?
#? A standard dialog.
#? 
#? %fBlue%Usage: xdialog [options]......%fblack%
#?
#? -icon		(image)	A valid  image created with "image create photo ...".
#? -default		(number)	Which button that should be focused by default.
#? -buttons		(list)	A list of buttons that should appear in the window.
#? -title		(string)	Text that should appear in the title bar of the window.
#? -message	(string)	Text that should appear next to the icon
#?


#--------------------- Widgets & Defaults ----------------------------
option add *Scrollbar.width         12 widgetDefault
option add *Scrollbar.borderWidth   1  widgetDefault

proc xbutton {w args} {
................................................................................
}

proc xmenu {w args} {
global c
c
eval "menu $w $args -tearoff $c(tearoff) -background $c(color-menubg) -foreground $c(color-menutxt) -activebackground $c(color-menuactive) -activeforeground $c(color-menuactivetext) -borderwidth 1 -activeborderwidth 0"
}

proc xdialog {args} {
	global result
	set wfocus ""

	if {[set i [lsearch -exact $args "-default"]] >= 0} {
		set default [lindex $args [expr $i+1]]
	} else { set default "none" }

	if {[set i [lsearch -exact $args "-icon"]] >= 0} {
		set icon [lindex $args [expr $i+1]]
	} else { set icon "" }

	if {[set i [lsearch -exact $args "-buttons"]] >= 0} {
		set buttons [lindex $args [expr $i+1]]
	} else { set buttons "Yes No" }

	if {[set i [lsearch -exact $args "-title"]] >= 0} {
		set title [lindex $args [expr $i+1]]
	} else { set title "?" }

	if {[set i [lsearch -exact $args "-message"]] >= 0} {
		set message [lindex $args [expr $i+1]]
	} else { set message "Are you sure ?" }

	set w .wdlg
	catch {destroy $w}
	toplevel $w

	wm protocol  $w WM_DELETE_WINDOW "set result -" 
	wm title $w $title
	wm iconbitmap $w ""
	wm resizable $w false false
	wm transient $w .
	set result "-"

	frame $w.frame 
	label $w.frame.label -text $message -wraplength 200

	pack $w.frame.label -fill y

	if {[llength $buttons]==1} {
		set b $buttons
		label $w.frame.a -width 5
		xbutton $w.frame.b -text $b -command "set result $b" -width 5 -underline 0
		bind $w <[string tolower [string range $b 0 0]]> "set result $b"
		bind $w <[string toupper [string range $b 0 0]]> "set result $b"
		label $w.frame.c -width 5
		pack $w.frame.a  $w.frame.b $w.frame.c -side left -padx 10
		set wfocus "$w.frame.b"
	}
	
	if {[llength $buttons]==2} {
		set b [lindex $buttons 0]
		xbutton $w.frame.a -text $b -command "set result $b" -width 5 -underline 0
		bind $w <[string tolower [string range $b 0 0]]> "set result $b"
		bind $w <[string toupper [string range $b 0 0]]> "set result $b"
		label $w.frame.b -width 5
		set b [lindex $buttons 1]
		xbutton $w.frame.c -text $b -command "set result $b" -width 5 -underline 0
		bind $w <[string tolower [string range $b 0 0]]> "set result $b"
		bind $w <[string toupper [string range $b 0 0]]> "set result $b"
		pack $w.frame.a  $w.frame.b $w.frame.c -side left -padx 10
		if {$default==0} { 	set wfocus "$w.frame.a" } 
		if {$default==1} { 	set wfocus "$w.frame.c" }
		if {$default=="none"} { set	wfocus "$w.frame" }		
	}

	if {[llength $buttons]>2} {
		foreach b $buttons {
			xbutton $w.frame.[string tolower $b] -text $b -command "set result $b" -width 5 -underline 0
			pack $w.frame.[string tolower $b] -side left -padx 10
			bind $w <[string tolower [string range $b 0 0]]> "set result $b"
			bind $w <[string toupper [string range $b 0 0]]> "set result $b"
		}
		if {$default!="none"} {
			set wfocus "$w.frame.[string tolower [lindex $buttons $default]]"
		} else {
			set wfocus "$w.frame"
		}
	}

	bind $w <Escape> "set result -"

	if {$icon!=""} {
		label $w.img -image $icon 
		pack $w.img $w.frame -side left 
	} else {
		pack $w.frame -side left 
	}

	powin $w
	grab $w
	if {$wfocus!=""} {focus -force $wfocus }

	vwait result
	destroy $w
	if {$result=="-"} { set result "" }
	return $result
}

#----------------------------------------------------------
proc Dialog {name inputname} {
global r

set dlg .dlg
catch {destroy $dlg}

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