TKE  2.9
Advanced code editor for programmers
embed_tke.tcl
Go to the documentation of this file.
1 # TKE - Advanced Programmer's Editor
2 # Copyright (C) 2014-2016 Trevor Williams (phase1geo@gmail.com)
3 #
4 # This program is free software; you can redistribute it and/or modify
5 # it under the terms of the GNU Lesser General Public License as published by
6 # the Free Software Foundation; either version 2 of the License, or
7 # (at your option) any later version.
8 #
9 # This program is distributed in the hope that it will be useful,
10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 # GNU General Public License for more details.
13 #
14 # You should have received a copy of the GNU General Public License along
15 # with this program; if not, write to the Free Software Foundation, Inc.,
16 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17 
18 ######################################################################
19 # Name: embed_tke.tcl
20 # Author: Trevor Williams (phase1geo@gmail.com)
21 # Date: 06/05/2014
22 # Brief: Package that provides an embeddable TKE editor to be used
23 # in external applications.
24 ######################################################################
25 
26 package provide embed_tke 1.0
27 
28 set tke_dir [file normalize [embed_tke::DIR]]
29 set tke_home [file normalize [file join ~ .tke]]
30 
31 set auto_path [concat [file join $tke_dir lib] $auto_path]
32 
33 package require -exact ctext 4.0
34 package require tooltip
35 
36 source [file join $tke_dir lib bgproc.tcl]
37 
38 namespace eval embed_tke {
39 
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]
50 
51  # Handle launcher requests
52  namespace eval launcher {
53  proc register {args} {}
54  proc unregister {args} {}
55  }
56 
57  namespace eval gui {
58  rename update_position update_position__orig
59  rename save_current save_current__orig
60  rename close_current close_current__orig
61 
62  proc update_position {args} {}
63  proc save_current {args} { puts "Saving"}
64  proc close_current {args} { puts "Closing"}
65  }
66 
67  variable right_click 3
68 
69  array set data {}
70  array set images {}
71 
72  array set widget_options {
73  -language {language Language}
74  }
75 
76  # On Mac, the right-click button is button 2
77  if {[tk windowingsystem] eq "aqua"} {
78  set right_click 2
79  }
80 
81  ######################################################################
82  # Creates an embeddable TKE widget and returns the pathname to the widget
83  proc embed_tke {w args} {
84 
85  variable data
86  variable images
87  variable widget_options
88  variable right_click
89 
90  # If this is the first time we have been called, do some initialization
91  if {[array size images] == 0} {
92 
93  # Initialize default options
94  option add *EmbedTke.language "None" widgetDefault
95 
96  # Create images
97  set imgdir [file join $::tke_dir lib images]
98  set images(split) \
99  [image create bitmap -file [file join $imgdir split.bmp] \
100  -maskfile [file join $imgdir split.bmp] \
101  -foreground grey10]
102  set images(close) \
103  [image create bitmap -file [file join $imgdir close.bmp] \
104  -maskfile [file join $imgdir close.bmp] \
105  -foreground grey10]
106  set images(global) \
107  [image create photo -file [file join $imgdir global.gif]]
108 
109  # Load the preferences
111 
112  # Load the snippets
114 
115  # Load the syntax highlighting information
117 
118  }
119 
120  # Create widget
121  ttk::frame $w
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
125  #-warnwidth $preferences::prefs(Editor/WarningWidth)
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"
129 
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"
140  bind Text <<Cut>> ""
141  bind Text <<Copy>> ""
142  bind Text <<Paste>> ""
143  bind Text <Control-d> ""
144  bind Text <Control-i> ""
145 
146  # Move the all bindtag ahead of the Text bindtag
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]
151 
152  # Create the Vim command bar
153  vim::bind_command_entry $w.txt \
154  [entry $w.ve -background black -foreground white -insertbackground white \
155  -font [$w.txt cget -font]] $w.txt
156 
157  # Create the search bar
158  ttk::frame $w.sf
159  ttk::label $w.sf.l1 -text [msgcat::mc "Find:"]
160  ttk::entry $w.sf.e
161  ttk::label $w.sf.case -text "Aa" -relief raised
162  ttk::label $w.sf.close -image $images(close)
163 
164  tooltip::tooltip $w.sf.case "Case sensitivity"
165 
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
170 
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"
177 
178  # Create the search/replace bar
179  ttk::frame $w.rf
180  ttk::label $w.rf.fl -text [msgcat::mc "Find:"]
181  ttk::entry $w.rf.fe
182  ttk::label $w.rf.rl -text [msgcat::mc "Replace:"]
183  ttk::entry $w.rf.re
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)
187 
188  tooltip::tooltip $w.rf.case "Case sensitivity"
189  tooltip::tooltip $w.rf.glob "Replace globally"
190 
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
198 
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"
212 
213  # FOOBAR
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
223 
224  # Hide the vim command entry, search bar, search/replace bar and search separator
225  grid remove $w.ve
226  grid remove $w.sf
227  grid remove $w.rf
228 
229  # Add the text bindings
230  indent::add_bindings $w.txt
233  vim::set_vim_mode $w.txt $w.txt
234 
235  # Apply the appropriate syntax highlighting for the given extension
236  syntax::set_language $w.txt "<None>"
237 
238  # Initialize the options array
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]]
241  }
242 
243  # Configure the widget
244  configure 1 $w {*}$args
245 
246  # Rename and alias the embed_tke window
247  rename ::$w $w
248  interp alias {} ::$w {} embed_tke::widget_cmd $w
249 
250  return $w
251 
252  }
253 
254  ######################################################################
255  # Calls the various widget commands.
256  proc widget_cmd {w args} {
257 
258  if {[llength $args] == 0} {
259  return -code error "embed_tke widget called without a command"
260  }
261 
262  set cmd [lindex $args 0]
263  set opts [lrange $args 1 end]
264 
265  switch $cmd {
266  cget { return [embed_tke::cget $w {*}$opts]}
267  configure { return [embed_tke::configure 0 $w {*}$opts]}
268  default { return -code error "Unknown embed_tke command ($cmd)"}
269  }
270 
271  }
272 
273  ######################################################################
274  # configure command.
275  proc configure {initialize w args} {
276 
277  variable data
278  variable widget_options
279 
280  if {([llength $args] == 0) && !$initialize} {
281 
282  set results [list]
283 
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)]
291  } else {
292  lappend results [list $opt $opt_name $opt_class $opt_default ""]
293  }
294  }
295  }
296 
297  return $results
298 
299  } elseif {([llength $args] == 1) && !$initialize} {
300 
301  set opt [lindex $args 0]
302 
303  if {[info exists widget_options($opt)]} {
304  if {[llength $widget_options($opt)] == 1} {
305  set opt [lindex $widget_options($opt) 0]
306  }
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)]
312  } else {
313  return [list $opt $opt_name $opt_class $opt_default ""]
314  }
315  }
316 
317  return -code error "tabbar::configuration option [lindex $args 0] does not exist"
318 
319  } else {
320 
321  # Save the original contents
322  array set orig_options [array get data $w,option,*]
323 
324  # Parse the arguments
325  foreach {name value} $args {
326  if {[info exists data($w,option,$name)]} {
327  set data($w,option,$name) $value
328  } else {
329  return -code error "Illegal option given to the embed_tke::configure command ($name)"
330  }
331  }
332 
333  # Set the language
334  if {$orig_options($w,option,-language) ne $data($w,option,-language)} {
335  if {[lsearch [syntax::get_all_languages] $data($w,option,-language)] != -1} {
336  syntax::set_language $w.txt $data($w,option,-language)
337  } else {
338  return -code error "Unknown language ($data($w,option,-language) specified in embed_tke::configure command"
339  }
340  }
341 
342  }
343 
344  }
345 
346  ######################################################################
347  # cget command.
348  proc cget {w args} {
349 
350  variable data
351 
352  # Verify the argument list is valid
353  if {[llength $args] != 1} {
354  return -code error "Incorrect number of parameters given to the embed_tke::cget command"
355  }
356 
357  if {[info exists data($w,option,[lindex $args 0])]} {
358  return $data($w,option,[lindex $args 0])
359  } else {
360  return -code error "Illegal options given to the embed_tke::cget command ([lindex $args 0])"
361  }
362 
363  }
364 
365 }