TKE  3.6
Advanced code editor for programmers
bindings Namespace Reference

Functions

 load
 
 use_default
 
 save max shortcuts
 
 load_file skip_base ?dummy?
 
 load_reversed_translations
 
 translate_to_en mnu_path
 
 apply_all_bindings
 
 remove_all_bindings
 
 is_cleared mnu
 
 accelerator_to_sequence accelerator
 
 accelerator_mapping value
 

Function Documentation

§ accelerator_mapping()

bindings::accelerator_mapping   value  

Definition at line 473 of file bindings.tcl.

473  proc accelerator_mapping {value} {
474 
475  array set map {
476  Ctrl,\u2303 0
477  Alt,\u2325 1
478  Shift,\u21e7 2
479  Cmd,\u2318 3
480  Up,\u2191 4
481  Down,\u2193 4
482  Left,\u2190 4
483  Right,\u2192 4
484  }
485 
486  # Special-case the asterisk character
487  if {($value eq "*") || ($value eq "?")} {
488  return [list 4 $value]
489  }
490 
491  if {[set key [array names map $value,*]] ne ""} {
492  return [list $map($key) [lindex [split $key ,] 1]]
493  } elseif {[set key [array names map *,$value]] ne ""} {
494  return [list $map($key) [lindex [split $key ,] 0]]
495  } elseif {[string length $value] == 2} {
496  return [list 4 [string index $value 1]]
497  } else {
498  return [list 4 $value]
499  }
500 
501  }

§ accelerator_to_sequence()

bindings::accelerator_to_sequence   accelerator  

Definition at line 303 of file bindings.tcl.

303  proc accelerator_to_sequence {accelerator} {
304 
305  set sequence "<"
306  set append_dash 0
307  set shift 0
308  set alt 0
309 
310  # Create character to keysym mapping
311  array set mapping {
312  Ctrl "Control-"
313  Alt "Alt-"
314  Cmd "Mod1-"
315  Super "Mod1-"
316  ! "exclam"
317  \" "quotedbl"
318  \# "numbersign"
319  \$ "dollar"
320  % "percent"
321  ' "quoteright"
322  ( "parenleft"
323  ) "parenright"
324  * "asterisk"
325  + "plus"
326  , "comma"
327  - "minus"
328  . "period"
329  / "slash"
330  : "colon"
331  ; "semicolon"
332  < "less"
333  = "equal"
334  > "greater"
335  ? "question"
336  @ "at"
337  \[ "bracketleft"
338  \\ "backslash"
339  \] "bracketright"
340  ^ "asciicircum"
341  _ "underscore"
342  ` "quoteleft"
343  \{ "braceleft"
344  | "bar"
345  \} "braceright"
346  ~ "asciitilde"
347  & "ampersand"
348  Space "space"
349  }
350 
351  array set shift_mapping {
352  1 "exclam"
353  2 "at"
354  3 "numbersign"
355  4 "dollar"
356  5 "percent"
357  6 "asciicircum"
358  7 "ampersand"
359  8 "asterisk"
360  9 "parenleft"
361  0 "parenright"
362  - "underscore"
363  = "plus"
364  \[ "bracketleft"
365  \] "bracketright"
366  \\ "bar"
367  ; "colon"
368  ' "quotedbl"
369  , "less"
370  . "greater"
371  / "question"
372  }
373 
374  # I don't believe there are any Alt key mappings on other platforms
375  array set alt_mapping {}
376 
377  # If we are on a Mac, adjust the mapping
378  if {[tk windowingsystem] eq "aqua"} {
379  unset mapping(Alt)
380  array set alt_mapping {
381  1 "exclamdown"
382  3 "sterling"
383  4 "cent"
384  6 "section"
385  7 "paragraph"
386  9 "ordfeminine"
387  0 "masculine"
388  r "registered"
389  y "yen"
390  o "oslash"
391  p "Amacron"
392  \\ "guillemotleft"
393  a "aring"
394  s "ssharp"
395  g "copyright"
396  l "notsign"
397  , "ae"
398  c "ccedilla"
399  m "mu"
400  / "division"
401  * "degree"
402  ( "periodcentered"
403  + "plusminus"
404  E "acute"
405  Y "Aacute"
406  U "diaeresis"
407  I "Ccircumflex"
408  O "Ooblique"
409  | "guillemotright"
410  A "Aring"
411  S "Iacute"
412  D "Icircumflex"
413  F "Idiaresis"
414  G "Ubreve"
415  H "Oacute"
416  J "Ocircumflex"
417  L "Ograve"
418  : "Uacute"
419  \" "AE"
420  z "cedilla"
421  C "Ccedilla"
422  M "Acircumflex"
423  < "macron"
424  > "Gcircumflex"
425  ? "questuondown"
426  }
427  }
428 
429  # If the sequence detail is the minus key, this will cause problems with the parser so
430  # remove it and append it at the end of the sequence.
431  if {[string range $accelerator end-1 end] eq "--"} {
432  set append_dash 1
433  set accelerator [string range $accelerator 0 end-2]
434  }
435 
436  # Create the sequence
437  foreach value [split $accelerator -] {
438  if {$alt && !$shift && [info exists alt_mapping([string tolower $value])]} {
439  append sequence $alt_mapping([string tolower $value])
440  } elseif {$alt && $shift && [info exists alt_mapping([string toupper $value])]} {
441  append sequence $alt_mapping([string toupper $value])
442  } elseif {$shift && [info exists shift_mapping($value)]} {
443  append sequence $shift_mapping($value)
444  } elseif {[info exists mapping($value)]} {
445  append sequence $mapping($value)
446  } elseif {$value eq "Shift"} {
447  append sequence "Shift-"
448  set shift 1
449  } elseif {$value eq "Alt"} {
450  set alt 1
451  } elseif {[string length $value] == 1} {
452  if {$alt} {
453  append sequence "Mod2-"
454  }
455  append sequence [string tolower $value]
456  } else {
457  append sequence $value
458  }
459  }
460 
461  if {$append_dash} {
462  append sequence "minus"
463  }
464 
465  append sequence ">"
466 
467  return $sequence
468 
469  }

§ apply_all_bindings()

bindings::apply_all_bindings

Definition at line 233 of file bindings.tcl.

233  proc apply_all_bindings {} {
234 
235  variable menu_bindings
236  variable bound_menus
237 
238  array unset bound_menus
239 
240  foreach {mnu_path binding} [array get menu_bindings] {
241  if {$binding eq ""} {
242  continue
243  }
244  set menu_list [split $mnu_path /]
245  if {![catch { menus::get_menu [lrange $menu_list 0 end-1]} mnu]} {
246  if {![catch { menus::get_menu_index $mnu [lindex $menu_list end]} menu_index] && ($menu_index ne "none")} {
247  set value [list "" "" "" "" ""]
248  if {[string range $binding end-1 end] eq "--"} {
249  set binding [string range $binding 0 end-2]
250  lset value 4 "-"
251  }
252  foreach elem [split $binding -] {
253  lset value [lindex [accelerator_mapping $elem] 0] $elem
254  }
255  set binding [join [concat {*}$value] -]
256  set bound_menus($mnu,$menu_index) $binding
257  $mnu entryconfigure $menu_index -accelerator $binding
258  bind all [accelerator_to_sequence $binding] "menus::invoke $mnu $menu_index; break"
259  }
260  }
261  }
262 
263  # Add bindings to entry, combobox and spinboxes
264  foreach win [list TEntry TCombobox TSpinbox] {
265  bind $win <Control-c> "event generate %W <<Copy>>; break"
266  bind $win <Control-x> "event generate %W <<Cut>>; break"
267  bind $win <Control-v> "event generate %W <<Paste>>; break"
268  }
269 
270  }

§ is_cleared()

bindings::is_cleared   mnu  

Definition at line 293 of file bindings.tcl.

293  proc is_cleared {mnu} {
294 
295  variable menu_bindings
296 
297  return [expr {[info exists menu_bindings($mnu)] && ($menu_bindings($mnu) eq "")}]
298 
299  }

§ load()

bindings::load

Definition at line 40 of file bindings.tcl.

40  proc load {} {
41 
42  # Load the menu bindings file
43  load_file 0
44 
45  }

§ load_file()

bindings::load_file   skip_base ?dummy?  

Definition at line 115 of file bindings.tcl.

115  proc load_file {skip_base {dummy 0}} {
116 
117  variable base_bindings_file
118  variable user_bindings_file
119  variable menu_bindings
120 
121  # Remove the existing bindings
123 
124  # Read in the base bindings file. Copy it to the user bindings file, if one does not exist.
125  if {!$skip_base} {
126  if {[file exists $user_bindings_file]} {
127  if {![catch { tkedat::read $base_bindings_file 0} rc]} {
128  array set menu_bindings $rc
129  array set reversed [lreverse $rc]
130  }
131  } else {
132  file copy -force $base_bindings_file $::tke_home
133  }
134  }
135 
136  # Read in the user bindings file.
137  if {![catch { tkedat::read $user_bindings_file 0} rc]} {
138 
139  # This block of code removes and default menu bindings that are in use by the user.
140  foreach {mnu binding} $rc {
141  if {[info exists reversed($binding)]} {
142  catch { unset menu_bindings($reversed($binding))}
143  }
144  set menu_bindings($mnu) $binding
145  }
146 
147  # Apply the bindings to the UI
149 
150  } else {
151 
152  # Remove all menu bindings if we were unable to read the user bindings file (this file should exist)
153  array unset menu_bindings
154 
155  }
156 
157  }

§ load_reversed_translations()

bindings::load_reversed_translations

Definition at line 165 of file bindings.tcl.

165  proc load_reversed_translations {} {
166 
167  variable reversed_translations
168  variable reversed_loaded
169 
170  # If we have already reversed the translations, don't continue
171  if {$reversed_loaded > 0} {
172  return
173  }
174 
175  # Get the list of translations that we support
176  set langs [glob -directory [file join $::tke_dir data msgs] -tails *.msg]
177 
178  # Figure out which language file is being used
179  set lang_file ""
180  foreach locale [msgcat::mcpreferences] {
181  if {[lsearch $langs $locale.msg] != -1} {
182  set lang_file $locale.msg
183  }
184  }
185 
186  # Indicate that we are loaded
187  set reversed_loaded 1
188 
189  # If we didn't find a translation file, the strings are going to be in English anyways
190  # so just return
191  if {$lang_file eq ""} {
192  return
193  }
194 
195  # We will remap the msgcat::mcmset procedure and create a new version of the command
196  rename ::msgcat::mcmset ::msgcat::mcmset_orig
197  proc ::msgcat::mcmset {lang translations} {
198  array set bindings::reversed_translations [lreverse $translations]
199  }
200  source -encoding utf-8 [file join $::tke_dir data msgs $lang_file]
201  rename ::msgcat::mcmset ""
202  rename ::msgcat::mcmset_orig ::msgcat::mcmset
203 
204  }

§ remove_all_bindings()

bindings::remove_all_bindings

Definition at line 274 of file bindings.tcl.

274  proc remove_all_bindings {} {
275 
276  variable menu_bindings
277  variable bound_menus
278 
279  # Delete all of the accelerators and bindings
280  foreach {mnu_index binding} [array get bound_menus] {
281  lassign [split $mnu_index ,] mnu index
282  catch { $mnu entryconfigure $index -accelerator ""}
283  bind all [accelerator_to_sequence $binding] ""
284  }
285 
286  # Delete the menu_bindings array
287  array unset menu_bindings
288 
289  }

§ save()

bindings::save   max shortcuts  

Definition at line 68 of file bindings.tcl.

68  proc save {max shortcuts} {
69 
70  variable user_bindings_file
71 
72  # Make sure the the reversed translations are loaded
74 
75  if {![catch { open $user_bindings_file w} rc]} {
76 
77  set last_mnu ""
78 
79  foreach shortcut $shortcuts {
80  set mnu_path [translate_to_en [lindex $shortcut 0]]
81  set mnu [lindex [split $mnu_path /] 0]
82  if {$mnu ne $last_mnu} {
83  if {$last_mnu ne ""} {
84  puts $rc ""
85  }
86  puts $rc "# [string totitle $mnu] menu bindings"
87  set last_mnu $mnu
88  }
89  puts -nonewline $rc "{$mnu_path}[string repeat { } [expr $max - [string length $mnu_path]]] "
90  if {[lindex $shortcut 1] eq ""} {
91  puts $rc "{}"
92  } else {
93  puts $rc [lindex $shortcut 1]
94  }
95  }
96 
97  # Close the file
98  close $rc
99 
100  # Next, load the file
101  load_file 1
102 
103  }
104 
105  }

§ translate_to_en()

bindings::translate_to_en   mnu_path  

Definition at line 208 of file bindings.tcl.

208  proc translate_to_en {mnu_path} {
209 
210  variable reversed_translations
211 
212  set new_mnu_path [list]
213 
214  foreach part [split $mnu_path /] {
215  set suffix ""
216  if {[string range $part end-2 end] eq "..."} {
217  set part [string range $part 0 end-3]
218  set suffix "..."
219  }
220  if {[info exists reversed_translations($part)]} {
221  lappend new_mnu_path $reversed_translations($part)$suffix
222  } else {
223  lappend new_mnu_path $part$suffix
224  }
225  }
226 
227  return [join $new_mnu_path /]
228 
229  }

§ use_default()

bindings::use_default

Definition at line 49 of file bindings.tcl.

49  proc use_default {} {
50 
51  variable user_bindings_file
52 
53  # If a user binding file exists, do the following
54  if {[file exists $user_bindings_file]} {
55 
56  # Remove the file
57  file delete -force $user_bindings_file
58 
59  # Reload the bindings
60  load_file 0
61 
62  }
63 
64  }