26 package provide embed_tke 1.0
28 set tke_dir [
file normalize [embed_tke::DIR]]
29 set tke_home [
file normalize [
file join ~ .tke]]
31 set auto_path [
concat [
file join $tke_dir lib] $auto_path]
33 package require -exact ctext 4.0
34 package require tooltip
36 source [
file join $tke_dir lib bgproc.tcl]
38 namespace eval embed_tke {
40 source [
file join [DIR] lib preferences.tcl]
41 source [
file join [DIR] lib tkedat.tcl]
42 source [
file join [DIR] lib gui.tcl]
43 source [
file join [DIR] lib vim.tcl]
44 source [
file join [DIR] lib syntax.tcl]
45 source [
file join [DIR] lib indent.tcl]
46 source [
file join [DIR] lib utils.tcl]
47 source [
file join [DIR] lib multicursor.tcl]
48 source [
file join [DIR] lib snippets.tcl]
49 source [
file join [DIR] lib markers.tcl]
52 namespace eval launcher {
53 proc register {args} {}
54 proc unregister {args} {}
58 rename update_position update_position__orig
59 rename save_current save_current__orig
60 rename close_current close_current__orig
62 proc update_position {args} {}
63 proc save_current {args} {
puts "Saving"}
64 proc close_current {args} {
puts "Closing"}
67 variable right_click 3
72 array set widget_options {
73 -language {language Language}
77 if {[tk windowingsystem] eq "aqua"} {
83 proc embed_tke {w args} {
87 variable widget_options
91 if {[
array size images] == 0} {
94 option add *EmbedTke.language "None" widgetDefault
97 set imgdir [
file join $::tke_dir lib images]
99 [
image create bitmap -file [
file join $imgdir split.bmp] \
100 -maskfile [
file join $imgdir split.bmp] \
103 [
image create bitmap -file [
file join $imgdir close.bmp] \
104 -maskfile [
file join $imgdir close.bmp] \
107 [
image create photo -file [
file join $imgdir global.gif]]
122 ctext $w.txt -wrap none -undo 1 -autoseparators 1 -insertofftime 0 \
123 -highlightcolor yellow \
124 -linemap_mark_command gui::mark_command -linemap_select_bg orange
126 ttk::label $w.split -image $images(split) -anchor center
127 ttk::scrollbar $w.vb -orient vertical -command "$w.txt yview"
128 ttk::scrollbar $w.hb -orient horizontal -command "$w.txt xview"
130 bind Ctext <<Modified>> "[
namespace current]::gui::text_changed %W"
131 bind $w.txt.l <ButtonPress-$right_click> [
bind $w.txt.l <ButtonPress-1>]
132 bind $w.txt.l <ButtonPress-1> "[
namespace current]::gui::select_line %W %y"
133 bind $w.txt.l <B1-Motion> "[
namespace current]::gui::select_lines %W %y"
134 bind $w.txt.l <Shift-ButtonPress-1> "[
namespace current]::gui::select_lines %W %y"
135 bind $w.txt <<Selection>> "[
namespace current]::gui::selection_changed %W"
136 bind $w.txt <ButtonPress-1> "after idle [list [
namespace current]::gui::update_position %W]"
137 bind $w.txt <B1-Motion> "[
namespace current]::gui::update_position %W"
138 bind $w.txt <KeyRelease> "[
namespace current]::gui::update_position %W"
139 bind $w.split <Button-1> "[
namespace current]::gui::toggle_split_pane $w.txt"
141 bind Text <<Copy>> ""
142 bind Text <<Paste>> ""
143 bind Text <Control-d> ""
144 bind Text <Control-i> ""
147 set text_index [lsearch [
bindtags $w.txt.t] Text]
148 set all_index [lsearch [
bindtags $w.txt.t] all]
149 bindtags $w.txt.t [
lreplace [
bindtags $w.txt.t] $all_index $all_index]
150 bindtags $w.txt.t [
linsert [
bindtags $w.txt.t] $text_index all]
154 [
entry $w.ve -background black -foreground white -insertbackground white \
155 -font [$w.txt cget -font]] $w.txt
159 ttk::label $w.sf.l1 -text [msgcat::mc "Find:"]
161 ttk::label $w.sf.case -text "Aa" -relief raised
162 ttk::label $w.sf.close -image $images(close)
164 tooltip::tooltip $w.sf.case "Case sensitivity"
166 pack $w.sf.l1 -side left -padx 2 -pady 2
167 pack $w.sf.e -side left -padx 2 -pady 2 -fill x -expand yes
168 pack $w.sf.close -side right -padx 2 -pady 2
169 pack $w.sf.case -side right -padx 2 -pady 2
171 bind $w.sf.e <Escape> "[
namespace current]::gui::close_search"
172 bind $w.sf.case <Button-1> "[
namespace current]::gui::toggle_labelbutton %W"
173 bind $w.sf.case <Key-space> "[
namespace current]::gui::toggle_labelbutton %W"
174 bind $w.sf.case <Escape> "[
namespace current]::gui::close_search"
175 bind $w.sf.close <Button-1> "[
namespace current]::gui::close_search"
176 bind $w.sf.close <Key-space> "[
namespace current]::gui::close_search"
180 ttk::label $w.rf.fl -text [msgcat::mc "Find:"]
182 ttk::label $w.rf.rl -text [msgcat::mc "Replace:"]
184 ttk::label $w.rf.case -text "Aa" -relief raised
185 ttk::label $w.rf.glob -image $images(global) -relief raised
186 ttk::label $w.rf.close -image $images(close)
188 tooltip::tooltip $w.rf.case "Case sensitivity"
189 tooltip::tooltip $w.rf.glob "Replace globally"
191 pack $w.rf.fl -side left -padx 2 -pady 2
192 pack $w.rf.fe -side left -padx 2 -pady 2 -fill x -expand yes
193 pack $w.rf.rl -side left -padx 2 -pady 2
194 pack $w.rf.re -side left -padx 2 -pady 2 -fill x -expand yes
195 pack $w.rf.case -side left -padx 2 -pady 2
196 pack $w.rf.glob -side left -padx 2 -pady 2
197 pack $w.rf.close -side left -padx 2 -pady 2
199 bind $w.rf.fe <Return> "[
namespace current]::gui::do_search_and_replace $w.txt"
200 bind $w.rf.re <Return> "[
namespace current]::gui::do_search_and_replace $w.txt"
201 bind $w.rf.glob <Return> "[
namespace current]::gui::do_search_and_replace $w.txt"
202 bind $w.rf.fe <Escape> "[
namespace current]::gui::close_search_and_replace"
203 bind $w.rf.re <Escape> "[
namespace current]::gui::close_search_and_replace"
204 bind $w.rf.case <Button-1> "[
namespace current]::gui::toggle_labelbutton %W"
205 bind $w.rf.case <Key-space> "[
namespace current]::gui::toggle_labelbutton %W"
206 bind $w.rf.case <Escape> "[
namespace current]::gui::close_search_and_replace"
207 bind $w.rf.glob <Button-1> "[
namespace current]::gui::toggle_labelbutton %W"
208 bind $w.rf.glob <Key-space> "[
namespace current]::gui::toggle_labelbutton %W"
209 bind $w.rf.glob <Escape> "[
namespace current]::gui::close_search_and_replace"
210 bind $w.rf.close <Button-1> "[
namespace current]::gui::close_search_and_replace"
211 bind $w.rf.close <Key-space> "[
namespace current]::gui::close_search_and_replace"
214 grid rowconfigure $w 1 -weight 1
215 grid columnconfigure $w 0 -weight 1
216 grid $w.txt -row 0 -column 0 -sticky news -rowspan 2
217 grid $w.split -row 0 -column 1 -sticky news
218 grid $w.vb -row 1 -column 1 -sticky ns
219 grid $w.hb -row 2 -column 0 -sticky ew
220 grid $w.ve -row 3 -column 0 -sticky ew
221 grid $w.sf -row 4 -column 0 -sticky ew
222 grid $w.rf -row 5 -column 0 -sticky ew
239 foreach opt [
array names widget_options] {
240 set data($w,option,$opt) [
option get $w [
lindex $widget_options($opt) 0] [
lindex $widget_options($opt) 1]]
248 interp alias {} ::$w {} embed_tke::widget_cmd $w
256 proc widget_cmd {w args} {
258 if {[
llength $args] == 0} {
259 return -code error "embed_tke widget called without a command"
262 set cmd [
lindex $args 0]
263 set opts [
lrange $args 1 end]
268 default {
return -code error "Unknown embed_tke command ($cmd)"}
275 proc configure {initialize w args} {
278 variable widget_options
280 if {([
llength $args] == 0) && !$initialize} {
284 foreach opt [lsort [
array names widget_options]] {
285 if {[
llength $widget_options($opt)] == 2} {
286 set opt_name [
lindex $widget_options($opt) 0]
287 set opt_class [
lindex $widget_options($opt) 1]
288 set opt_default [
option get $w $opt_name $opt_class]
289 if {[
info exists data($w,option,$opt)]} {
290 lappend results [list $opt $opt_name $opt_class $opt_default $data($w,option,$opt)]
292 lappend results [list $opt $opt_name $opt_class $opt_default ""]
299 }
elseif {([
llength $args] == 1) && !$initialize} {
301 set opt [
lindex $args 0]
303 if {[
info exists widget_options($opt)]} {
304 if {[
llength $widget_options($opt)] == 1} {
305 set opt [
lindex $widget_options($opt) 0]
307 set opt_name [
lindex $widget_options($opt) 0]
308 set opt_class [
lindex $widget_options($opt) 1]
309 set opt_default [
option get $w $opt_name $opt_class]
310 if {[
info exists data($w,option,$opt)]} {
311 return [list $opt $opt_name $opt_class $opt_default $data($w,option,$opt)]
313 return [list $opt $opt_name $opt_class $opt_default ""]
317 return -code error "tabbar::configuration option [
lindex $args 0] does not exist"
322 array set orig_options [
array get data $w,option,*]
325 foreach {name value} $args {
326 if {[
info exists data($w,option,$name)]} {
327 set data($w,option,$name) $value
329 return -code error "Illegal option given to the embed_tke::configure command ($name)"
334 if {$orig_options($w,option,-language) ne $data($w,option,-language)} {
338 return -code error "Unknown language ($data($w,option,-language) specified in embed_tke::configure command"
353 if {[
llength $args] != 1} {
354 return -code error "Incorrect number of parameters given to the embed_tke::cget command"
357 if {[
info exists data($w,option,[
lindex $args 0])]} {
358 return $data($w,option,[
lindex $args 0])
360 return -code error "Illegal options given to the embed_tke::cget command ([
lindex $args 0])"