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: snippets.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 5/11/2013 00022 # Brief: Namespace containing functionality to support snippets 00023 ###################################################################### 00024 00025 namespace eval snippets { 00026 00027 array set widgets {} 00028 array set snippets {} 00029 array set timestamps {} 00030 array set within {} 00031 array set expandtabs {} 00032 00033 set snippets_dir [file join $::tke_home snippets] 00034 00035 ###################################################################### 00036 # Loads the snippet information. 00037 proc load {} { 00038 00039 variable snippets_dir 00040 00041 # If the snippets directory does not exist, create it 00042 if {![file exists $snippets_dir]} { 00043 file mkdir $snippets_dir 00044 } 00045 00046 } 00047 00048 ###################################################################### 00049 # Reloads the current snippet. 00050 proc reload_snippets {} { 00051 00052 # Get the current language 00053 set language [syntax::get_language [gui::current_txt]] 00054 00055 # Reload the snippet file for the current language 00056 set_language $language 00057 00058 } 00059 00060 ###################################################################### 00061 # Load the snippets file. 00062 proc set_language {language {dummy 0}} { 00063 00064 variable snippets 00065 variable timestamps 00066 variable snippets_dir 00067 00068 # Remove any launcher commands that would be associated with this file 00069 launcher::unregister [msgcat::mc "Snippet: *"] 00070 00071 foreach lang [list user $language] { 00072 00073 # Create language-specific snippets filename if it exists 00074 if {[file exists [set sfile [file join $snippets_dir $lang.snippets]]]} { 00075 00076 # Get the file status 00077 file stat $sfile fstat 00078 00079 # Check to see if the language file timestamp has been updated 00080 if {![info exists timestamps($lang)] || ($fstat(mtime) > $timestamps($lang))} { 00081 set timestamps($lang) $fstat(mtime) 00082 parse_snippets $lang 00083 } 00084 00085 } 00086 00087 } 00088 00089 } 00090 00091 ###################################################################### 00092 # Sets the expandtabs memory for the given text widget to the given value. 00093 proc set_expandtabs {txt val} { 00094 00095 variable expandtabs 00096 00097 set expandtabs($txt.t) $val 00098 00099 } 00100 00101 ###################################################################### 00102 # Parses snippets for the given language. 00103 proc parse_snippets {language} { 00104 00105 variable snippets 00106 variable snippets_dir 00107 00108 # Clear the snippets for the given file 00109 array unset snippets $language,* 00110 00111 # Create snippet file name 00112 set sfile [file join $snippets_dir $language.snippets] 00113 00114 if {![catch { open $sfile r } rc]} { 00115 00116 # Read the contents of the snippets file 00117 set contents [read $rc] 00118 close $rc 00119 00120 set in_snippet 0 00121 set tab_seen 0 00122 00123 # Do a quick parse of the snippets file 00124 foreach line [concat [split $contents \n] ""] { 00125 if {$in_snippet} { 00126 if {[regexp {^\t(.*)$} $line -> txt]} { 00127 append snippet "[string trimright $txt]\n" 00128 set tab_seen 1 00129 } elseif {([string trim $line] eq "endsnippet") || (([string trim $line] eq "") && $tab_seen)} { 00130 set in_snippet 0 00131 set snippets($language,$name) [string range $snippet 0 end-1] 00132 } else { 00133 append snippet "[string trimright $line]\n" 00134 } 00135 } 00136 if {[regexp {^snippet\s+(\w+)} $line -> name]} { 00137 set in_snippet 1 00138 set snippet "" 00139 set tab_seen 0 00140 } 00141 00142 } 00143 00144 } 00145 00146 if {$language eq "snippets"} { 00147 set_language snippets 00148 } 00149 00150 } 00151 00152 ###################################################################### 00153 # Adds the text widget bindings. 00154 proc add_bindings {txt} { 00155 00156 variable within 00157 variable expandtabs 00158 00159 # Initialize the within array 00160 set within($txt.t) 0 00161 set expandtabs($txt.t) [expr [syntax::get_tabs_allowed $txt] ? 0 : 1] 00162 00163 # Bind whitespace 00164 bind snippet$txt <Key-space> "if {\[snippets::check_snippet %W %K\]} { break }" 00165 bind snippet$txt <Return> "if {\[snippets::check_snippet %W %K\]} { break }" 00166 bind snippet$txt <Tab> "if {\[snippets::handle_tab %W\]} { break }" 00167 00168 set all_index [lsearch -exact [bindtags $txt.t] all] 00169 bindtags $txt.t [linsert [bindtags $txt.t] $all_index snippet$txt] 00170 00171 } 00172 00173 ###################################################################### 00174 # Called whenever the given text widget is destroyed. 00175 proc handle_destroy_txt {txt} { 00176 00177 variable within 00178 variable expandtabs 00179 00180 unset -nocomplain within($txt.t) 00181 unset -nocomplain expandtabs($txt.t) 00182 00183 } 00184 00185 ###################################################################### 00186 # Handles a tab key event. 00187 proc handle_tab {txtt} { 00188 00189 variable expandtabs 00190 00191 if {![tab_clicked $txtt]} { 00192 if {![vim::in_vim_mode $txtt]} { 00193 if {[string is space [$txtt get insert]] || ([lsearch [$txtt tag names insert] __prewhite] != -1)} { 00194 if {$expandtabs($txtt)} { 00195 $txtt insert insert [string repeat " " [indent::get_tabstop $txtt]] 00196 return 1 00197 } 00198 } elseif {[set index [$txtt search -regexp -- {\s} insert "insert+1l linestart"]] ne ""} { 00199 ::tk::TextSetCursor $txtt $index 00200 return 1 00201 } 00202 } 00203 } else { 00204 return 1 00205 } 00206 00207 return 0 00208 00209 } 00210 00211 ###################################################################### 00212 # Checks the text widget to see if a snippet name was just typed in 00213 # the text widget. If it was, delete the string and replace it with 00214 # the snippet string. 00215 proc check_snippet {txtt keysym} { 00216 00217 variable snippets 00218 variable tabpoints 00219 00220 # If the given key symbol is not one of the snippet completers, stop now 00221 if {[lsearch [preferences::get Editor/SnippetCompleters] [string tolower $keysym]] == -1} { 00222 return 0 00223 } 00224 00225 # Get the last word 00226 set last_word [string trim [$txtt get "insert-1c wordstart" "insert-1c wordend"]] 00227 00228 # Get the current language 00229 set lang [utils::get_current_lang [winfo parent $txtt]] 00230 00231 # If the snippet exists, perform the replacement. 00232 foreach type [list $lang user] { 00233 if {[info exists snippets($type,$last_word)]} { 00234 return [insert_snippet $txtt $snippets($type,$last_word) -delrange [list "insert-1c wordstart" "insert-1c wordend"]] 00235 } 00236 } 00237 00238 return 0 00239 00240 } 00241 00242 ###################################################################### 00243 # Inserts the given snippet contents at the current insertion point. 00244 proc insert_snippet {txtt snippet args} { 00245 00246 variable tabpoints 00247 00248 array set opts { 00249 -delrange "" 00250 -traverse 1 00251 -separator 1 00252 } 00253 array set opts $args 00254 00255 # Clear any residual tabstops 00256 clear_tabstops $txtt 00257 00258 # Initialize tabpoints 00259 set tabpoints($txtt) 1 00260 00261 # Mark the change 00262 if {$opts(-separator)} { 00263 $txtt edit separator 00264 } 00265 00266 # Delete the last_word, if specified 00267 if {$opts(-delrange) ne ""} { 00268 $txtt delete {*}$opts(-delrange) 00269 } 00270 00271 # Call the snippet parser 00272 if {[set result [parse_snippet $txtt $snippet]] ne ""} { 00273 00274 # Get the snippet marks 00275 set marks [lsearch -glob -inline -all [$txtt tag names] snippet_*] 00276 00277 # Add a $0 tabstop (if one was not specified) 00278 if {([llength $marks] > 0) && ([lsearch $marks snippet_mark_0] == -1)} { 00279 set_tabstop $txtt 0 00280 lappend result \$0 snippet_mark_0 00281 } 00282 00283 # Get the insertion cursor 00284 set insert [$txtt index insert] 00285 00286 # Insert the text 00287 $txtt insert insert {*}$result 00288 00289 # Format the text to match indentation 00290 if {[preferences::get Editor/SnippetFormatAfterInsert]} { 00291 set datalen 0 00292 foreach {str tags} $result { 00293 incr datalen [string length $str] 00294 } 00295 indent::format_text $txtt $insert "$insert+${datalen}c" 0 00296 } 00297 00298 # Traverse the inserted snippet 00299 if {$opts(-traverse)} { 00300 traverse_snippet $txtt 00301 } 00302 00303 } 00304 00305 # Adjust the cursor, if necessary 00306 vim::adjust_insert $txtt 00307 00308 # Create a separator 00309 $txtt edit separator 00310 00311 return 1 00312 00313 } 00314 00315 ###################################################################### 00316 # Inserts the given snippet into the current text widget, adhering to 00317 # indentation rules. 00318 proc insert_snippet_into_current {snippet args} { 00319 00320 insert_snippet [gui::current_txt].t $snippet {*}$args 00321 00322 } 00323 00324 ###################################################################### 00325 # Parses the given snippet string and returns 00326 proc parse_snippet {txtt str} { 00327 00328 # Flush the parsing buffer 00329 SNIP__FLUSH_BUFFER 00330 00331 # Insert the string to scan 00332 snip__scan_string $str 00333 00334 # Initialize some values 00335 set ::snip_txtt $txtt 00336 set ::snip_begpos 0 00337 set ::snip_endpos 0 00338 00339 # Parse the string 00340 if {[catch { snip_parse } rc] || ($rc != 0)} { 00341 display_error $str $::snip_errstr $::snip_errmsg 00342 return "" 00343 } 00344 00345 return $::snip_value 00346 00347 } 00348 00349 ###################################################################### 00350 # Creates a tab stop or tab mirror. 00351 proc set_tabstop {txtt index {default_value ""}} { 00352 00353 variable tabpoints 00354 variable within 00355 00356 # Indicate that the text widget contains a tabstop 00357 set within($txtt) 1 00358 00359 # Set the lowest tabpoint value 00360 if {($index > 0) && ($tabpoints($txtt) > $index)} { 00361 set tabpoints($txtt) $index 00362 } 00363 00364 # Get the list of tags 00365 set tags [$txtt tag names] 00366 00367 if {[lsearch -regexp $tags snippet_(sel|mark)_$index] != -1} { 00368 if {[lsearch $tags snippet_mirror_$index] == -1} { 00369 $txtt tag configure snippet_mirror_$index -elide 1 00370 } 00371 return "snippet_mirror_$index" 00372 } else { 00373 if {$default_value eq ""} { 00374 $txtt tag configure snippet_mark_$index -elide 1 00375 return "snippet_mark_$index" 00376 } else { 00377 $txtt tag configure snippet_sel_$index -background blue 00378 return "snippet_sel_$index" 00379 } 00380 } 00381 00382 } 00383 00384 ###################################################################### 00385 # Returns the value of the given tabstop. 00386 proc get_tabstop {txtt index} { 00387 00388 variable tabvals 00389 00390 if {[info exists tabvals($txtt,$index)]} { 00391 return $tabvals($txtt,$index) 00392 } 00393 00394 return "" 00395 00396 } 00397 00398 ###################################################################### 00399 # Clears any residual tabstops embedded in code. 00400 proc clear_tabstops {txtt} { 00401 00402 variable tabvals 00403 00404 # Delete all text that is tagged with a snippet tag 00405 foreach tabstop [lsearch -inline -all -glob [$txtt tag names] snippet_*] { 00406 foreach {start end} [$txtt tag ranges $tabstop] { 00407 $txtt fastdelete $start $end 00408 } 00409 $txtt tag delete $tabstop 00410 } 00411 00412 array unset tabvals $txtt,* 00413 00414 } 00415 00416 ###################################################################### 00417 # Handles a tab insertion 00418 proc tab_clicked {txtt} { 00419 00420 variable within 00421 00422 if {$within($txtt)} { 00423 traverse_snippet $txtt 00424 return 1 00425 } else { 00426 return [check_snippet $txtt Tab] 00427 } 00428 00429 } 00430 00431 ###################################################################### 00432 # Moves the insertion cursor or selection to the next position in the 00433 # snippet. 00434 proc traverse_snippet {txtt} { 00435 00436 variable tabpoints 00437 variable within 00438 variable tabstart 00439 variable tabvals 00440 00441 if {[info exists tabpoints($txtt)]} { 00442 00443 # Update any mirrored tab points 00444 if {[info exists tabstart($txtt)]} { 00445 set index [expr $tabpoints($txtt) - 1] 00446 set tabvals($txtt,$index) [$txtt get $tabstart($txtt) insert] 00447 foreach {endpos startpos} [lreverse [$txtt tag ranges snippet_mirror_$index]] { 00448 set str [parse_snippet $txtt [$txtt get $startpos $endpos]] 00449 $txtt fastdelete $startpos $endpos 00450 $txtt insert $startpos {*}$str 00451 } 00452 } 00453 00454 # Remove the selection 00455 $txtt tag remove sel 1.0 end 00456 00457 # Find the current tab point tag 00458 if {[llength [set range [$txtt tag ranges snippet_sel_$tabpoints($txtt)]]] == 2} { 00459 $txtt tag delete snippet_sel_$tabpoints($txtt) 00460 ::tk::TextSetCursor $txtt [lindex $range 1] 00461 $txtt tag add sel {*}$range 00462 set tabstart($txtt) [lindex $range 0] 00463 } elseif {[llength [set range [$txtt tag ranges snippet_mark_$tabpoints($txtt)]]] == 2} { 00464 $txtt fastdelete {*}$range 00465 ::tk::TextSetCursor $txtt [lindex $range 0] 00466 $txtt tag delete snippet_mark_$tabpoints($txtt) 00467 set tabstart($txtt) [lindex $range 0] 00468 } elseif {[llength [set range [$txtt tag ranges snippet_mark_0]]] == 2} { 00469 $txtt fastdelete {*}$range 00470 ::tk::TextSetCursor $txtt [lindex $range 0] 00471 $txtt tag delete snippet_mark_0 00472 set tabstart($txtt) [lindex $range 0] 00473 } 00474 00475 # Increment the tabpoint 00476 incr tabpoints($txtt) 00477 00478 # Clear the within indicator if we are out of tab stops 00479 if {([$txtt tag ranges snippet_sel_$tabpoints($txtt)] eq "") && \ 00480 ([$txtt tag ranges snippet_mark_$tabpoints($txtt)] eq "") && \ 00481 ([$txtt tag ranges snippet_mark_0] eq "")} { 00482 set within($txtt) 0 00483 } 00484 00485 } 00486 00487 } 00488 00489 ###################################################################### 00490 # Returns the list of snippets 00491 proc get_current_snippets {} { 00492 00493 variable snippets 00494 00495 set names [list] 00496 set lang [utils::get_current_lang [gui::current_txt]] 00497 00498 foreach type [list user $lang] { 00499 foreach name [array names snippets $type,*] { 00500 lappend names [list [lindex [split $name ,] 1] $snippets($name)] 00501 } 00502 } 00503 00504 return $names 00505 00506 } 00507 00508 ###################################################################### 00509 # Displays all of the available snippets in the current editor in the 00510 # command launcher. 00511 proc show_snippets {} { 00512 00513 # Add temporary registries to launcher 00514 set i 0 00515 foreach snippet [get_current_snippets] { 00516 lassign $snippet name value 00517 launcher::register_temp "`SNIPPET:$name" \ 00518 [list snippets::insert_snippet_into_current $value] \ 00519 $name $i [list snippets::add_detail $value] 00520 incr i 00521 } 00522 00523 # Display the launcher in SNIPPET: mode 00524 launcher::launch "`SNIPPET:" 1 00525 00526 } 00527 00528 ###################################################################### 00529 # Adds the given detail 00530 proc add_detail {str txt} { 00531 00532 $txt insert end $str 00533 00534 } 00535 00536 ###################################################################### 00537 # Displays the error information when a snippet parsing error is detected. 00538 proc display_error {snip_str ptr_str error_info} { 00539 00540 if {![winfo exists .snipwin]} { 00541 00542 toplevel .snipwin 00543 wm title .snipwin "Snippet Error" 00544 wm transient .snipwin . 00545 wm resizable .snipwin 0 0 00546 00547 ttk::labelframe .snipwin.f -text "Error Information" 00548 text .snipwin.f.t -wrap none -width 60 -relief flat -borderwidth 0 \ 00549 -highlightthickness 0 \ 00550 -background [utils::get_default_background] -foreground [utils::get_default_foreground] \ 00551 -xscrollcommand { .snipwin.f.hb set } -yscrollcommand { .snipwin.f.vb set } 00552 scroller::scroller .snipwin.f.vb -orient vertical -command { .snipwin.f.t xview } 00553 scroller::scroller .snipwin.f.hb -orient horizontal -command { .snipwin.f.t yview } 00554 00555 grid rowconfigure .snipwin.f 0 -weight 1 00556 grid columnconfigure .snipwin.f 0 -weight 1 00557 grid .snipwin.f.t -row 0 -column 0 -sticky news 00558 grid .snipwin.f.vb -row 0 -column 1 -sticky ns 00559 grid .snipwin.f.hb -row 1 -column 0 -sticky ew 00560 00561 ttk::frame .snipwin.bf 00562 ttk::button .snipwin.bf.okay -style BButton -text "Close" -width 5 -command { destroy .snipwin } 00563 00564 pack .snipwin.bf.okay -padx 2 -pady 2 00565 00566 pack .snipwin.f -fill both -expand yes 00567 pack .snipwin.bf -fill x 00568 00569 # Make sure that the window is centered in the window 00570 ::tk::PlaceWindow .snipwin widget . 00571 00572 } else { 00573 00574 # Clear the text widget 00575 .snipwin.f.t configure -state normal 00576 .snipwin.f.t delete 1.0 end 00577 00578 } 00579 00580 # Insert the error information into the text widget 00581 foreach line [split $snip_str \n] { 00582 set ptr [string range $ptr_str 0 [string length $line]] 00583 set ptr_str [string range $ptr_str [expr [string length $line] + 1] end] 00584 .snipwin.f.t insert end "$line\n" 00585 if {[string trim $ptr] ne ""} { 00586 .snipwin.f.t insert end "$ptr\n" 00587 } 00588 } 00589 .snipwin.f.t insert end "\n$error_info" 00590 .snipwin.f.t configure -state disabled 00591 .snipwin.f.t configure -height [expr {([set lines [.snipwin.f.t count -lines 1.0 end]] < 20) ? $lines : 20}] 00592 00593 } 00594 00595 ###################################################################### 00596 # Perform snippet substitutions of the given text string. 00597 proc substitute {str lang} { 00598 00599 # Returns the string if there are no snippets to expand 00600 if {![regexp {<tke:ExportString>.*</tke:ExportString>} $str]} { 00601 return $str 00602 } 00603 00604 # Place an escape character before dollar signs and backticks 00605 set str [string map {\$ {\$} ` {\`}} $str] 00606 00607 # Convert the string 00608 while {[regexp {^(.*)<tke:ExportString>(.*?)</tke:ExportString>(.*)$} $str -> pre snip post]} { 00609 set snip [string map {{\$} \$ {\`} `} $snip] 00610 set str "$pre$snip$post" 00611 } 00612 00613 # Create a temporary editing buffer 00614 set tab [gui::add_buffer end temporary [list] -lang $lang -background 1] 00615 00616 # Get the current text widget 00617 gui::get_info $tab tab txt 00618 00619 # Insert the content as a snippet 00620 snippets::insert_snippet $txt.t $str -traverse 0 00621 00622 # Get the text 00623 set str [gui::scrub_text $txt] 00624 00625 # Close the tab 00626 gui::close_tab {} $tab -keeptab 0 -check 0 00627 00628 return $str 00629 00630 } 00631 00632 ###################################################################### 00633 # Returns a list of snippet information from the given file. 00634 proc load_list {language} { 00635 00636 variable snippets_dir 00637 variable snippets 00638 00639 if {$language eq "All"} { 00640 set language "user" 00641 } 00642 00643 # Parse the snippets file 00644 parse_snippets $language 00645 00646 # Configure the snippets into a list 00647 set items [list] 00648 foreach key [array names snippets $language,*] { 00649 lappend items [list [lindex [split $key ,] 1] $snippets($key)] 00650 } 00651 00652 return $items 00653 00654 } 00655 00656 ###################################################################### 00657 # Saves the given snippet items to the appropriate snippet file. 00658 proc save_list {items language} { 00659 00660 variable snippets_dir 00661 00662 if {$language eq "All"} { 00663 set language "user" 00664 } 00665 00666 if {![catch { open [file join $snippets_dir $language.snippets] w } rc]} { 00667 foreach item $items { 00668 lassign $item keyword snippet 00669 puts $rc "snippet $keyword" 00670 puts $rc $snippet 00671 puts $rc "endsnippet\n" 00672 } 00673 close $rc 00674 } 00675 00676 # Re-parse the file 00677 set_language $language 00678 00679 } 00680 00681 ###################################################################### 00682 # Returns the list of files in the TKE home directory to copy. 00683 proc get_share_items {dir} { 00684 00685 return [list snippets] 00686 00687 } 00688 00689 ###################################################################### 00690 # Called whenever the share directory changes. 00691 proc share_changed {dir} { 00692 00693 variable snippets_dir 00694 00695 set snippets_dir [file join $dir snippets] 00696 00697 } 00698 00699 } 00700