00001 # TKE - Advanced Programmer's Editor 00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com) 00003 # 00004 # This program is free software; you can redistribute it and/or modify 00005 # it under the terms of the GNU General Public License as published by 00006 # the Free Software Foundation; either version 2 of the License, or 00007 # (at your option) any later version. 00008 # 00009 # This program is distributed in the hope that it will be useful, 00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of 00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00012 # GNU General Public License for more details. 00013 # 00014 # You should have received a copy of the GNU General Public License along 00015 # with this program; if not, write to the Free Software Foundation, Inc., 00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 00017 00018 ###################################################################### 00019 # Name: completer.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 11/4/2014 00022 # Brief: Contains namespace handling bracket/string completion. 00023 #################################################################### 00024 00025 namespace eval completer { 00026 00027 array set pref_complete {} 00028 array set complete {} 00029 array set lang_match_chars {} 00030 00031 trace add variable preferences::prefs(Editor/AutoMatchChars) write completer::handle_auto_match_chars 00032 00033 ###################################################################### 00034 # Handles any changes to the Editor/AutoMatchChars preference value. 00035 proc handle_auto_match_chars {name1 name2 op} { 00036 00037 variable pref_complete 00038 variable lang_match_chars 00039 00040 # Populate the pref_complete array with the values from the preferences file 00041 array set pref_complete { 00042 square 0 00043 curly 0 00044 angled 0 00045 paren 0 00046 double 0 00047 single 0 00048 btick 0 00049 } 00050 00051 foreach value [preferences::get Editor/AutoMatchChars] { 00052 set pref_complete($value) 1 00053 } 00054 00055 # Update all text widgets 00056 foreach key [array names lang_match_chars] { 00057 lassign [split $key ,] txtt lang 00058 set_auto_match_chars $txtt $lang $lang_match_chars($key) 00059 } 00060 00061 } 00062 00063 ###################################################################### 00064 # Sets the auto-match characters based on the current language. 00065 proc set_auto_match_chars {txtt lang matchchars} { 00066 00067 variable lang_match_chars 00068 variable pref_complete 00069 variable complete 00070 00071 # Save the language-specific match characters 00072 set lang_match_chars($txtt,$lang) $matchchars 00073 00074 # Initialize the complete array for the given text widget 00075 array set complete [list \ 00076 $txtt,$lang,square 0 \ 00077 $txtt,$lang,curly 0 \ 00078 $txtt,$lang,angled 0 \ 00079 $txtt,$lang,paren 0 \ 00080 $txtt,$lang,double 0 \ 00081 $txtt,$lang,single 0 \ 00082 $txtt,$lang,btick 0 \ 00083 ] 00084 00085 # Combine the language-specific match chars with preference chars 00086 foreach match_char $lang_match_chars($txtt,$lang) { 00087 if {$pref_complete($match_char)} { 00088 set complete($txtt,$lang,$match_char) 1 00089 } 00090 } 00091 00092 } 00093 00094 ###################################################################### 00095 # Adds bindings to the given text widget. 00096 proc add_bindings {txt} { 00097 00098 bind precomp$txt <Key-bracketleft> "completer::add_square %W left" 00099 bind precomp$txt <Key-bracketright> "if {\[completer::add_square %W right\]} { break }" 00100 bind precomp$txt <Key-braceleft> "completer::add_curly %W left" 00101 bind precomp$txt <Key-braceright> "if {\[completer::add_curly %W right\]} { break }" 00102 bind precomp$txt <Key-less> "completer::add_angled %W left" 00103 bind precomp$txt <Key-greater> "if {\[completer::add_angled %W right\]} { break }" 00104 bind precomp$txt <Key-parenleft> "completer::add_paren %W left" 00105 bind precomp$txt <Key-parenright> "if {\[completer::add_paren %W right\]} { break }" 00106 bind precomp$txt <Key-quotedbl> "if {\[completer::add_double %W\]} { break }" 00107 bind precomp$txt <Key-quoteright> "if {\[completer::add_single %W\]} { break }" 00108 bind precomp$txt <Key-quoteleft> "if {\[completer::add_btick %W\]} { break }" 00109 bind precomp$txt <BackSpace> "completer::handle_delete %W" 00110 00111 # Add the bindings 00112 set text_index [lsearch [bindtags $txt.t] Text] 00113 bindtags $txt.t [linsert [bindtags $txt.t] [expr $text_index + 1] postcomp$txt] 00114 bindtags $txt.t [linsert [bindtags $txt.t] $text_index precomp$txt] 00115 00116 # Make sure that the complete array is initialized for the text widget 00117 # in case there is no language 00118 set_auto_match_chars $txt.t {} {} 00119 00120 } 00121 00122 ###################################################################### 00123 # Called whenever the given text widget is destroyed. 00124 proc handle_destroy_txt {txt} { 00125 00126 variable complete 00127 variable lang_match_chars 00128 00129 array unset completer::complete $txt.t,* 00130 array unset completer::lang_match_chars $txt.t,* 00131 00132 } 00133 00134 ###################################################################### 00135 # Returns true if a closing character should be automatically added. 00136 # This is called when an opening character is detected. 00137 proc add_closing {txtt} { 00138 00139 # Get the character at the insertion cursor 00140 set ch [$txtt get insert] 00141 00142 if {[string is space $ch] || ($ch eq "\}") || ($ch eq "\)") || ($ch eq ">") || ($ch eq "]")} { 00143 return 1 00144 } 00145 00146 return 0 00147 00148 } 00149 00150 ###################################################################### 00151 # Returns true if a closing character should be omitted from insertion. 00152 # This is called when a closing character is detected. 00153 proc skip_closing {txtt type} { 00154 00155 return [expr [lsearch [$txtt tag names insert] __${type}R] != -1] 00156 00157 } 00158 00159 ###################################################################### 00160 # Handles a square bracket. 00161 proc add_square {txtt side} { 00162 00163 variable complete 00164 00165 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],square) && \ 00166 ![$txtt is incomment "insert-1c"] && \ 00167 ![$txtt is escaped insert]} { 00168 if {$side eq "right"} { 00169 if {[skip_closing $txtt square]} { 00170 ::tk::TextSetCursor $txtt "insert+1c" 00171 return 1 00172 } 00173 } else { 00174 set ins [$txtt index insert] 00175 if {[add_closing $txtt]} { 00176 $txtt fastinsert insert "\]" 00177 } 00178 ::tk::TextSetCursor $txtt $ins 00179 } 00180 } 00181 00182 return 0 00183 00184 } 00185 00186 ###################################################################### 00187 # Handles a curly bracket. 00188 proc add_curly {txtt side} { 00189 00190 variable complete 00191 00192 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],curly) && \ 00193 ![$txtt is incomment "insert-1c"] && \ 00194 ![$txtt is escaped insert]} { 00195 if {$side eq "right"} { 00196 if {[skip_closing $txtt curly]} { 00197 ::tk::TextSetCursor $txtt "insert+1c" 00198 return 1 00199 } 00200 } else { 00201 set ins [$txtt index insert] 00202 if {[add_closing $txtt]} { 00203 $txtt fastinsert insert "\}" 00204 } 00205 ::tk::TextSetCursor $txtt $ins 00206 } 00207 } 00208 00209 return 0 00210 00211 } 00212 00213 ###################################################################### 00214 # Handles an angled bracket. 00215 proc add_angled {txtt side} { 00216 00217 variable complete 00218 00219 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],angled) && \ 00220 ![$txtt is incomment "insert-1c"] && \ 00221 ![$txtt is escaped insert]} { 00222 if {$side eq "right"} { 00223 if {[skip_closing $txtt angled]} { 00224 ::tk::TextSetCursor $txtt "insert+1c" 00225 return 1 00226 } 00227 } else { 00228 set ins [$txtt index insert] 00229 if {[add_closing $txtt]} { 00230 $txtt fastinsert insert ">" 00231 } 00232 ::tk::TextSetCursor $txtt $ins 00233 } 00234 } 00235 00236 return 0 00237 00238 } 00239 00240 ###################################################################### 00241 # Handles a parenthesis. 00242 proc add_paren {txtt side} { 00243 00244 variable complete 00245 00246 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],paren) && \ 00247 ![$txtt is incomment "insert-1c"] && \ 00248 ![$txtt is escaped insert]} { 00249 if {$side eq "right"} { 00250 if {[skip_closing $txtt paren]} { 00251 ::tk::TextSetCursor $txtt "insert+1c" 00252 return 1 00253 } 00254 } else { 00255 set ins [$txtt index insert] 00256 if {[add_closing $txtt]} { 00257 $txtt fastinsert insert ")" 00258 } 00259 ::tk::TextSetCursor $txtt $ins 00260 } 00261 } 00262 00263 return 0 00264 00265 } 00266 00267 ###################################################################### 00268 # Handles a double-quote character. 00269 proc add_double {txtt} { 00270 00271 variable complete 00272 00273 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],double)} { 00274 if {[$txtt is indouble insert]} { 00275 if {([$txtt get insert] eq "\"") && ![$txtt is escaped insert]} { 00276 ::tk::TextSetCursor $txtt "insert+1c" 00277 return 1 00278 } 00279 } elseif {[$txtt is indouble end-1c]} { 00280 return 0 00281 } else { 00282 set ins [$txtt index insert] 00283 if {![$txtt is incommentstring "insert-1c"]} { 00284 $txtt fastinsert insert "\"" 00285 } 00286 ::tk::TextSetCursor $txtt $ins 00287 } 00288 } 00289 00290 return 0 00291 00292 } 00293 00294 ###################################################################### 00295 # Handles a single-quote character. 00296 proc add_single {txtt} { 00297 00298 variable complete 00299 00300 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],single)} { 00301 if {[$txtt is insingle insert]} { 00302 if {([$txtt get insert] eq "'") && ![$txtt is escaped insert]} { 00303 ::tk::TextSetCursor $txtt "insert+1c" 00304 return 1 00305 } 00306 } elseif {[$txtt is insingle end-1c]} { 00307 return 0 00308 } else { 00309 set ins [$txtt index insert] 00310 if {![$txtt is incommentstring "insert-1c"]} { 00311 $txtt fastinsert insert "'" 00312 } 00313 ::tk::TextSetCursor $txtt $ins 00314 } 00315 } 00316 00317 return 0 00318 00319 } 00320 00321 ###################################################################### 00322 # Handles a backtick character. 00323 proc add_btick {txtt} { 00324 00325 variable complete 00326 00327 if {$complete($txtt,[ctext::getLang $txtt "insert-1c"],btick)} { 00328 if {[$txtt is inbtick insert]} { 00329 if {([$txtt get insert] eq "`") && ![$txtt is escaped insert]} { 00330 ::tk::TextSetCursor $txtt "insert+1c" 00331 return 1 00332 } 00333 } elseif {[$txtt is inbtick end-1c]} { 00334 return 0 00335 } else { 00336 set ins [$txtt index insert] 00337 if {![$txtt is incommentstring "insert-1c"]} { 00338 $txtt fastinsert insert "`" 00339 } 00340 ::tk::TextSetCursor $txtt $ins 00341 } 00342 } 00343 00344 return 0 00345 00346 } 00347 00348 ###################################################################### 00349 # Handles a deletion. 00350 proc handle_delete {txtt} { 00351 00352 variable complete 00353 00354 if {![$txtt is incomment insert-2c] && ![$txtt is escaped insert-1c]} { 00355 set lang [ctext::getLang $txtt insert] 00356 switch [$txtt get insert-1c insert+1c] { 00357 "\[\]" { 00358 if {$complete($txtt,$lang,square)} { 00359 $txtt fastdelete insert 00360 return 00361 } 00362 } 00363 "\{\}" { 00364 if {$complete($txtt,$lang,curly)} { 00365 $txtt fastdelete insert 00366 return 00367 } 00368 } 00369 "<>" { 00370 if {$complete($txtt,$lang,angled)} { 00371 $txtt fastdelete insert 00372 return 00373 } 00374 } 00375 "()" { 00376 if {$complete($txtt,$lang,paren)} { 00377 $txtt fastdelete insert 00378 return 00379 } 00380 } 00381 "\"\"" { 00382 if {$complete($txtt,$lang,double)} { 00383 $txtt fastdelete insert 00384 return 00385 } 00386 } 00387 "''" { 00388 if {$complete($txtt,$lang,single)} { 00389 $txtt fastdelete insert 00390 return 00391 } 00392 } 00393 "``" { 00394 if {$complete($txtt,$lang,btick)} { 00395 $txtt fastdelete insert 00396 return 00397 } 00398 } 00399 } 00400 } 00401 00402 } 00403 00404 }