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: edit.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 05/21/2013 00022 # Brief: Namespace containing procedures used for editing. These are 00023 # shared between Vim and non-Vim modes of operation. 00024 ###################################################################### 00025 00026 namespace eval edit { 00027 00028 variable columns "" 00029 00030 array set patterns { 00031 nnumber {^([0-9]+|0x[0-9a-fA-F]+|[0-9]*\.[0-9]+)} 00032 pnumber {([0-9]+|0x[0-9a-fA-F]+|[0-9]+\.[0-9]*)$} 00033 sentence {[.!?][])\"']*\s+\S} 00034 nspace {^[ \t]+} 00035 pspace {[ \t]+$} 00036 } 00037 00038 variable rot13_map { 00039 a n b o c p d q e r f s g t h u i v j w k x l y m z n a o b p c q d r e s f t g u h v i w j x k y l z m 00040 A N B O C P D Q E R F S G T H U I V J W K X L Y M Z N A O B P C Q D R E S F T G U H V I W J X K Y L Z M 00041 } 00042 00043 ###################################################################### 00044 # Inserts the line above the current line in the given editor. 00045 proc insert_line_above_current {txtt} { 00046 00047 # If we are operating in Vim mode, 00048 vim::edit_mode $txtt 00049 00050 # Create the new line 00051 if {[multicursor::enabled $txtt]} { 00052 multicursor::move $txtt up 00053 } elseif {[$txtt compare "insert linestart" == 1.0]} { 00054 $txtt insert "insert linestart" "\n" 00055 ::tk::TextSetCursor $txtt "insert-1l" 00056 } else { 00057 ::tk::TextSetCursor $txtt "insert-1l lineend" 00058 $txtt insert "insert lineend" "\n" 00059 } 00060 00061 indent::newline $txtt insert 1 00062 00063 } 00064 00065 ###################################################################### 00066 # Inserts a blank line below the current line in the given editor. 00067 proc insert_line_below_current {txtt} { 00068 00069 # If we are operating in Vim mode, switch to edit mode 00070 vim::edit_mode $txtt 00071 00072 # Get the current insertion point 00073 set insert [$txtt index insert] 00074 00075 # Add the line(s) 00076 if {[multicursor::enabled $txtt]} { 00077 multicursor::move $txtt down 00078 } else { 00079 ::tk::TextSetCursor $txtt "insert lineend" 00080 $txtt insert "insert lineend" "\n" 00081 } 00082 00083 # Make sure the inserted text is seen 00084 $txtt see insert 00085 00086 # Perform the proper indentation 00087 indent::newline $txtt insert 1 00088 00089 } 00090 00091 ###################################################################### 00092 # Inserts the given file contents beneath the current insertion line. 00093 proc insert_file {txt fname} { 00094 00095 # Attempt to open the file 00096 if {[catch { open $fname r } rc]} { 00097 return 00098 } 00099 00100 # Read the contents of the file and close the file 00101 set contents [read $rc] 00102 close $rc 00103 00104 # Insert the file contents beneath the current insertion line 00105 $txt insert "insert lineend" "\n$contents" 00106 00107 # Adjust the insertion point, if necessary 00108 vim::adjust_insert $txt 00109 00110 } 00111 00112 ###################################################################### 00113 # Checks to see if any text is currently selected. If it is, performs 00114 # the deletion on the selected text. 00115 proc delete_selected {txtt line} { 00116 00117 # If we have selected text, perform the deletion 00118 if {[llength [set selected [$txtt tag ranges sel]]] > 0} { 00119 00120 # Allow multicursors to be handled, if enabled 00121 if {![multicursor::delete $txtt selected]} { 00122 00123 if {$line} { 00124 00125 # Save the selected text to the clipboard 00126 clipboard clear 00127 foreach {start end} $selected { 00128 clipboard append [$txtt get "$start linestart" "$end lineend"] 00129 } 00130 00131 # Set the cursor to the first character of the selection prior to deletion 00132 $txtt mark set insert [lindex $selected 0] 00133 00134 # Delete the text 00135 foreach {end start} [lreverse $selected] { 00136 $txtt delete "$start linestart" "$end lineend" 00137 } 00138 00139 } else { 00140 00141 # Save the selected text to the clipboard 00142 clipboard clear 00143 foreach {start end} $selected { 00144 clipboard append [$txtt get $start $end] 00145 } 00146 00147 # Set the cursor to the first character of the selection prior to deletion 00148 $txtt mark set insert [lindex $selected 0] 00149 00150 # Delete the text 00151 foreach {end start} [lreverse $selected] { 00152 $txtt delete $start $end 00153 } 00154 00155 } 00156 00157 } 00158 00159 return 1 00160 00161 } 00162 00163 return 0 00164 00165 } 00166 00167 ###################################################################### 00168 # Deletes the current line. 00169 proc delete_current_line {txtt copy {num 1}} { 00170 00171 # Clear the clipboard and copy the line(s) that will be deleted 00172 if {$copy} { 00173 clipboard clear 00174 clipboard append [$txtt get "insert linestart" "insert+${num}l linestart"] 00175 } 00176 00177 # If we are deleting the last line, move the cursor up one line 00178 if {[$txtt compare "insert+${num}l linestart" == end]} { 00179 if {[$txtt compare "insert linestart" == 1.0]} { 00180 $txtt delete "insert linestart" "insert lineend" 00181 } else { 00182 set new_index [$txtt index "insert-1l"] 00183 $txtt delete "insert-1l lineend" "end-1c" 00184 $txtt mark set insert $new_index 00185 } 00186 } else { 00187 $txtt delete "insert linestart" "insert+${num}l linestart" 00188 } 00189 00190 # Position the cursor at the beginning of the first word 00191 move_cursor $txtt firstchar 00192 00193 # Adjust the insertion cursor 00194 if {$copy} { 00195 vim::adjust_insert $txtt 00196 } 00197 00198 } 00199 00200 ###################################################################### 00201 # Deletes the current word (i.e., dw Vim mode). 00202 proc delete {txtt startpos endpos copy adjust} { 00203 00204 # If the starting and ending position are the same, return now 00205 if {[$txtt compare $startpos == $endpos]} { 00206 return 00207 } 00208 00209 # Copy the text to the clipboard, if specified 00210 if {$copy} { 00211 clipboard clear 00212 clipboard append [$txtt get $startpos $endpos] 00213 } 00214 00215 set insertpos "" 00216 00217 if {[$txtt compare $endpos == end]} { 00218 if {[$txtt compare $startpos == 1.0]} { 00219 set endpos "$startpos lineend" 00220 } elseif {[$txtt compare $startpos == "$startpos linestart"]} { 00221 set insertpos "$startpos-1l" 00222 set startpos "$startpos-1l lineend" 00223 set endpos "end-1c" 00224 } 00225 } 00226 00227 # Delete the text 00228 $txtt delete $startpos $endpos 00229 00230 # Adjust the insertion cursor if this was a delete and not a change 00231 if {$adjust} { 00232 if {$insertpos ne ""} { 00233 $txtt mark set insert $insertpos 00234 } 00235 vim::adjust_insert $txtt 00236 } 00237 00238 } 00239 00240 ###################################################################### 00241 # Delete from the current cursor to the end of the line 00242 proc delete_to_end {txtt copy {num 1}} { 00243 00244 # Delete from the current cursor to the end of the line 00245 if {[multicursor::enabled $txtt]} { 00246 multicursor::delete $txtt "lineend" 00247 } else { 00248 set endpos [get_index $txtt lineend -num $num]+1c 00249 if {$copy} { 00250 clipboard clear 00251 clipboard append [$txtt get insert $endpos] 00252 } 00253 $txtt delete insert $endpos 00254 if {$copy} { 00255 vim::adjust_insert $txtt 00256 } 00257 } 00258 00259 } 00260 00261 ###################################################################### 00262 # Delete from the start of the current line to just before the current cursor. 00263 proc delete_from_start {txtt copy} { 00264 00265 # Delete from the beginning of the line to just before the current cursor 00266 if {[multicursor::enabled $txtt]} { 00267 multicursor::delete $txtt "linestart" 00268 } else { 00269 if {$copy} { 00270 clipboard clear 00271 clipboard append [$txtt get "insert linestart" insert] 00272 } 00273 $txtt delete "insert linestart" insert 00274 } 00275 00276 } 00277 00278 ###################################################################### 00279 # Delete from the start of the firstchar to just before the current cursor. 00280 proc delete_to_firstchar {txtt copy} { 00281 00282 if {[multicursor::enabled $txtt]} { 00283 multicursor::delete $txtt firstchar 00284 } else { 00285 set firstchar [get_index $txtt firstchar] 00286 if {[$txtt compare $firstchar < insert]} { 00287 if {$copy} { 00288 clipboard clear 00289 clipboard append [$txtt get $firstchar insert] 00290 } 00291 $txtt delete $firstchar insert 00292 } elseif {[$txtt compare $firstchar > insert]} { 00293 if {$copy} { 00294 clipboard clear 00295 clipboard append [$txtt get insert $firstchar] 00296 } 00297 $txtt delete insert $firstchar 00298 if {$copy} { 00299 vim::adjust_insert $txtt 00300 } 00301 } 00302 } 00303 00304 } 00305 00306 ###################################################################### 00307 # Delete all consecutive numbers from cursor to end of line. 00308 proc delete_next_numbers {txtt copy} { 00309 00310 variable patterns 00311 00312 if {[multicursor::enabled $txtt]} { 00313 multicursor::delete $txtt pattern $patterns(nnumber) 00314 } elseif {[regexp $patterns(nnumber) [$txtt get insert "insert lineend"] match]} { 00315 if {$copy} { 00316 clipboard clear 00317 clipboard append [$txtt get insert "insert+[string length $match]c"] 00318 } 00319 $txtt delete insert "insert+[string length $match]c" 00320 if {$copy} { 00321 vim::adjust_insert $txtt 00322 } 00323 } 00324 00325 } 00326 00327 ###################################################################### 00328 # Deletes all consecutive numbers from the insertion toward the start of 00329 # the current line. 00330 proc delete_prev_numbers {txtt copy} { 00331 00332 variable patterns 00333 00334 if {[multicursor::enabled $txtt]} { 00335 multicursor::delete $txtt pattern $patterns(pnumber) 00336 } elseif {[regexp $patterns(pnumber) [$txtt get "insert linestart" insert] match]} { 00337 if {$copy} { 00338 clipboard clear 00339 clipboard append [$txtt get "insert-[string length $match]c" insert] 00340 } 00341 $txtt delete "insert-[string length $match]c" insert 00342 } 00343 00344 } 00345 00346 ###################################################################### 00347 # Deletes all consecutive whitespace starting from cursor to the end of 00348 # the line. 00349 proc delete_next_space {txtt} { 00350 00351 variable patterns 00352 00353 if {[multicursor::enabled $txtt]} { 00354 multicursor::delete $txtt pattern $patterns(nspace) 00355 } elseif {[regexp $patterns(nspace) [$txtt get insert "insert lineend"] match]} { 00356 $txtt delete insert "insert+[string length $match]c" 00357 } 00358 00359 } 00360 00361 ###################################################################### 00362 # Deletes all consecutive whitespace starting from cursor to the start 00363 # of the line. 00364 proc delete_prev_space {txtt} { 00365 00366 variable patterns 00367 00368 if {[multicursor::enabled $txtt]} { 00369 multicursor::delete $txtt pattern $patterns(pspace) 00370 } elseif {[regexp $patterns(pspace) [$txtt get "insert linestart" insert] match]} { 00371 $txtt delete "insert-[string length $match]c" insert 00372 } 00373 00374 } 00375 00376 ###################################################################### 00377 # Deletes from the current insert postion to (and including) the next 00378 # character on the current line. 00379 proc delete_to_next_char {txtt char copy {num 1} {exclusive 0}} { 00380 00381 if {[set index [find_char $txtt next $char $num insert $exclusive]] ne "insert"} { 00382 if {$copy} { 00383 clipboard clear 00384 clipboard append [$txtt get insert $index] 00385 } 00386 $txtt delete insert $index 00387 if {$copy && $inclusive} { 00388 vim::adjust_insert $txtt 00389 } 00390 } 00391 00392 } 00393 00394 ###################################################################### 00395 # Deletes from the current insert position to (and including) the 00396 # previous character on the current line. 00397 proc delete_to_prev_char {txtt char copy {num 1} {exclusive 0}} { 00398 00399 if {[set index [find_char $txtt prev $char $num insert $exclusive]] ne "insert"} { 00400 if {$copy} { 00401 clipboard clear 00402 clipboard append [$txtt get $index insert] 00403 } 00404 $txtt delete $index insert 00405 } 00406 00407 } 00408 00409 ###################################################################### 00410 # Get the start and end positions for the pair defined by char. 00411 proc get_char_positions {txtt char} { 00412 00413 array set pairs { 00414 \{ {\\\} L} 00415 \} {\\\{ R} 00416 \( {\\\) L} 00417 \) {\\\( R} 00418 \[ {\\\] L} 00419 \] {\\\[ R} 00420 < {> L} 00421 > {< R} 00422 } 00423 00424 # Initialize 00425 set retval [set end_index 0] 00426 00427 # Get the matching character 00428 if {[info exists pairs($char)]} { 00429 if {[lindex $pairs($char) 1] eq "R"} { 00430 if {[set start_index [gui::find_match_pair $txtt [lindex $pairs($char) 0] \\$char -backwards]] != -1} { 00431 set retval [expr {[set end_index [gui::find_match_pair $txtt \\$char [lindex $pairs($char) 0] -forwards]] != -1}] 00432 } 00433 } else { 00434 if {[set start_index [gui::find_match_pair $txtt \\$char [lindex $pairs($char) 0] -backwards]] != -1} { 00435 set retval [expr {[set end_index [gui::find_match_pair $txtt [lindex $pairs($char) 0] \\$char -forwards]] != -1}] 00436 } 00437 } 00438 } else { 00439 if {[set start_index [gui::find_match_char $txtt $char -backwards]] != -1} { 00440 set retval [expr {[set end_index [gui::find_match_char $txtt $char -forwards]] != -1}] 00441 } 00442 } 00443 00444 return [list $start_index $end_index $retval] 00445 00446 } 00447 00448 ###################################################################### 00449 # Deletes all text found between the given character such that the 00450 # current insertion cursor sits between the character set. Returns 1 00451 # if a match occurred (and text was deleted); otherwise, returns 0. 00452 proc delete_between_char {txtt char copy} { 00453 00454 if {[lassign [get_char_positions $txtt $char] start_index end_index]} { 00455 if {$copy} { 00456 clipboard clear 00457 clipboard append [$txtt get $start_index+1c $end_index] 00458 } 00459 $txtt delete $start_index+1c $end_index 00460 return 1 00461 } 00462 00463 return 0 00464 00465 } 00466 00467 ###################################################################### 00468 # Converts a character-by-character case inversion of the given text. 00469 proc convert_case_toggle {txtt startpos endpos} { 00470 00471 # Get the string 00472 set str [$txtt get $startpos $endpos] 00473 00474 # Adjust the string so that we don't add an extra new line 00475 if {[string index $str end] eq "\n"} { 00476 set str [string range $str 0 end-1] 00477 } 00478 00479 set strlen [string length $str] 00480 set newstr "" 00481 00482 for {set i 0} {$i < $strlen} {incr i} { 00483 set char [string index $str $i] 00484 append newstr [expr {[string is lower $char] ? [string toupper $char] : [string tolower $char]}] 00485 } 00486 00487 $txtt replace $startpos "$startpos+${strlen}c" $newstr 00488 00489 } 00490 00491 ###################################################################### 00492 # Converts the case to the given type on a word basis. 00493 proc convert_case_to_title {txtt startpos endpos} { 00494 00495 set i 0 00496 foreach index [$txtt search -all -count lengths -regexp -- {\w+} $startpos $endpos] { 00497 set endpos [$txtt index "$index+[lindex $lengths $i]c"] 00498 set word [$txtt get $index $endpos] 00499 $txtt replace $index $endpos [string totitle $word] 00500 incr i 00501 } 00502 00503 # Set the cursor 00504 ::tk::TextSetCursor $txtt $startpos 00505 00506 } 00507 00508 ###################################################################### 00509 # Converts the given string 00510 proc convert_to_lower_case {txtt startpos endpos} { 00511 00512 # Get the string 00513 set str [$txtt get $startpos $endpos] 00514 00515 # Substitute the text 00516 $txtt replace $startpos "$startpos+[string length $str]c" [string tolower $str] 00517 00518 } 00519 00520 ###################################################################### 00521 # Converts the given string 00522 proc convert_to_upper_case {txtt startpos endpos} { 00523 00524 # Get the string 00525 set str [$txtt get $startpos $endpos] 00526 00527 # Substitute the text 00528 $txtt replace $startpos "$startpos+[string length $str]c" [string toupper $str] 00529 00530 } 00531 00532 ###################################################################### 00533 # Converts the text to rot13. 00534 proc convert_to_rot13 {txtt startpos endpos} { 00535 00536 variable rot13_map 00537 00538 # Get the string 00539 set str [$txtt get $startpos $endpos] 00540 00541 # Perform the substitution 00542 $txtt replace $startpos "$startpos+[string length $str]c" [string map $rot13_map $str] 00543 00544 # Set the cursor 00545 ::tk::TextSetCursor $txtt $startpos 00546 00547 } 00548 00549 ###################################################################### 00550 # If text is selected, the case will be toggled for each selected 00551 # character. Returns 1 if selected text was found; otherwise, returns 0. 00552 proc transform_toggle_case_selected {txtt} { 00553 00554 if {[llength [set ranges [$txtt tag ranges sel]]] > 0} { 00555 foreach {endpos startpos} [lreverse $ranges] { 00556 convert_case_toggle $txtt $startpos $endpos 00557 } 00558 ::tk::TextSetCursor $txtt $startpos 00559 return 1 00560 } 00561 00562 return 0 00563 00564 } 00565 00566 ###################################################################### 00567 # Perform a case toggle operation. 00568 proc transform_toggle_case {txtt startpos endpos {cursorpos insert}} { 00569 00570 if {![transform_toggle_case_selected $txtt]} { 00571 convert_case_toggle $txtt $startpos $endpos 00572 ::tk::TextSetCursor $txtt $cursorpos 00573 } 00574 00575 } 00576 00577 ###################################################################### 00578 # If text is selected, the case will be lowered for each selected 00579 # character. Returns 1 if selected text was found; otherwise, returns 0. 00580 proc transform_to_lower_case_selected {txtt} { 00581 00582 if {[llength [set ranges [$txtt tag ranges sel]]] > 0} { 00583 foreach {endpos startpos} [lreverse $ranges] { 00584 convert_to_lower_case $txtt $startpos $endpos 00585 } 00586 ::tk::TextSetCursor $txtt $startpos 00587 return 1 00588 } 00589 00590 return 0 00591 00592 } 00593 00594 ###################################################################### 00595 # Perform a lowercase conversion. 00596 proc transform_to_lower_case {txtt startpos endpos {cursorpos insert}} { 00597 00598 if {![transform_to_lower_case_selected $txtt]} { 00599 convert_to_lower_case $txtt $startpos $endpos 00600 ::tk::TextSetCursor $txtt $cursorpos 00601 } 00602 00603 } 00604 00605 ###################################################################### 00606 # If text is selected, the case will be uppered for each selected 00607 # character. Returns 1 if selected text was found; otherwise, returns 0. 00608 proc transform_to_upper_case_selected {txtt} { 00609 00610 if {[llength [set ranges [$txtt tag ranges sel]]] > 0} { 00611 foreach {endpos startpos} [lreverse $ranges] { 00612 convert_to_upper_case $txtt $startpos $endpos 00613 } 00614 ::tk::TextSetCursor $txtt $startpos 00615 return 1 00616 } 00617 00618 return 0 00619 00620 } 00621 00622 ###################################################################### 00623 # Perform an uppercase conversion. 00624 proc transform_to_upper_case {txtt startpos endpos {cursorpos insert}} { 00625 00626 if {![transform_to_upper_case_selected $txtt]} { 00627 convert_to_upper_case $txtt $startpos $endpos 00628 ::tk::TextSetCursor $txtt $cursorpos 00629 } 00630 00631 } 00632 00633 ###################################################################### 00634 # If text is selected, the selected text will be rot13'ed. Returns 1 00635 # if selected text was found; otherwise, returns 0. 00636 proc transform_to_rot13_selected {txtt} { 00637 00638 if {[llength [set ranges [$txtt tag ranges sel]]] > 0} { 00639 foreach {endpos startpos} [lreverse $ranges] { 00640 convert_to_rot13 $txtt $startpos $endpos 00641 } 00642 ::tk::TextSetCursor $txtt $startpos 00643 return 1 00644 } 00645 00646 return 0 00647 00648 } 00649 00650 ###################################################################### 00651 # Transforms all text in the given range to rot13. 00652 proc transform_to_rot13 {txtt startpos endpos {cursorpos insert}} { 00653 00654 if {![transform_to_rot13_selected $txtt]} { 00655 convert_to_rot13 $txtt $startpos $endpos 00656 ::tk::TextSetCursor $txtt $cursorpos 00657 } 00658 00659 } 00660 00661 ###################################################################### 00662 # Perform a title case conversion. 00663 proc transform_to_title_case {txtt startpos endpos {cursorpos insert}} { 00664 00665 if {[llength [set sel_ranges [$txtt tag ranges sel]]] > 0} { 00666 foreach {endpos startpos} [lreverse $sel_ranges] { 00667 convert_case_to_title $txtt [$txtt index "$startpos wordstart"] $endpos 00668 } 00669 ::tk::TextSetCursor $txtt $startpos 00670 } else { 00671 set str [$txtt get "insert wordstart" "insert wordend"] 00672 convert_case_to_title $txtt [$txtt index "$startpos wordstart"] $endpos 00673 ::tk::TextSetCursor $txtt $cursorpos 00674 } 00675 00676 } 00677 00678 ###################################################################### 00679 # If a selection occurs, joins the selected lines; otherwise, joins the 00680 # number of specified lines. 00681 # TBD - Needs work 00682 proc transform_join_lines {txtt {num 1}} { 00683 00684 # Specifies if at least one line was deleted in the join 00685 set deleted 0 00686 00687 # Create a separator 00688 $txtt edit separator 00689 00690 if {[llength [set selected [$txtt tag ranges sel]]] > 0} { 00691 00692 # Clear the selection 00693 $txtt tag remove sel 1.0 end 00694 00695 set lastpos "" 00696 foreach {endpos startpos} [lreverse $selected] { 00697 set lines [$txtt count -lines $startpos $endpos] 00698 for {set i 0} {$i < $lines} {incr i} { 00699 set line [string trimleft [$txtt get "$startpos+1l linestart" "$startpos+1l lineend"]] 00700 $txtt delete "$startpos lineend" "$startpos+1l lineend" 00701 if {![string is space [$txtt get "$startpos lineend-1c"]]} { 00702 set line " $line" 00703 } 00704 if {$line ne ""} { 00705 $txtt insert "$startpos lineend" $line 00706 } 00707 } 00708 set deleted [expr $deleted || ($lines > 0)] 00709 if {$lastpos ne ""} { 00710 set line [string trimleft [$txtt get "$lastpos linestart" "$lastpos lineend"]] 00711 $txtt delete "$lastpos-1l lineend" "$lastpos lineend" 00712 if {![string is space [$txtt get "$startpos lineend-1c"]]} { 00713 set line " $line" 00714 } 00715 $txtt insert "$startpos lineend" $line 00716 } 00717 set lastpos $startpos 00718 } 00719 00720 set index [$txtt index "$startpos lineend-[string length $line]c"] 00721 00722 } elseif {[$txtt compare "insert+1l" < end]} { 00723 00724 for {set i 0} {$i < $num} {incr i} { 00725 set line [string trimleft [$txtt get "insert+1l linestart" "insert+1l lineend"]] 00726 $txtt delete "insert lineend" "insert+1l lineend" 00727 if {![string is space [$txtt get "insert lineend-1c"]]} { 00728 set line " $line" 00729 } 00730 if {$line ne ""} { 00731 $txtt insert "insert lineend" $line 00732 } 00733 } 00734 00735 set deleted [expr $num > 0] 00736 set index [$txtt index "insert lineend-[string length $line]c"] 00737 00738 } 00739 00740 if {$deleted} { 00741 00742 # Set the insertion cursor and make it viewable 00743 ::tk::TextSetCursor $txtt $index 00744 00745 # Create a separator 00746 $txtt edit separator 00747 00748 } 00749 00750 } 00751 00752 ###################################################################### 00753 # Returns the number of newlines contained in the given string. 00754 proc newline_count {str} { 00755 00756 return [expr {[string length $str] - [string length [string map {\n {}} $str]]}] 00757 00758 } 00759 00760 ###################################################################### 00761 # Moves selected lines or the current line up by one line. 00762 proc transform_bubble_up {txtt} { 00763 00764 # Create undo separator 00765 $txtt edit separator 00766 00767 # If lines are selected, move all selected lines up one line 00768 if {[llength [set selected [$txtt tag ranges sel]]] > 0} { 00769 00770 switch [set type [select::get_type $txtt]] { 00771 none - 00772 line { 00773 foreach {end_range start_range} [lreverse $selected] { 00774 set str [$txtt get "$start_range-1l linestart" "$start_range linestart"] 00775 $txtt delete "$start_range-1l linestart" "$start_range linestart" 00776 if {[$txtt compare "$end_range linestart" == end]} { 00777 set str "\n[string trimright $str]" 00778 } 00779 $txtt insert "$end_range linestart" $str 00780 } 00781 } 00782 sentence { 00783 set startpos [get_index $txtt $type -dir prev -startpos [lindex $selected 0]] 00784 regexp {^(.*?)(\s*)$} [$txtt get $startpos [lindex $selected 0]] -> pstr pbetween 00785 regexp {^(.*?)(\s*)$} [$txtt get [lindex $selected 0] [lindex $selected end]] -> cstr cbetween 00786 if {$cbetween eq ""} { 00787 set cbetween " " 00788 } 00789 if {[newline_count $pbetween] >= 2} { 00790 set wo_ws [string trimright [set full [$txtt get [lindex $selected 0] [lindex $selected end]]]] 00791 set eos [$txtt index "[lindex $selected 0]+[string length $wo_ws]c"] 00792 $txtt delete $eos [lindex $selected end] 00793 $txtt insert $eos $pbetween sel 00794 $txtt replace "[lindex $selected 0]-[string length $pbetween]c" [lindex $selected 0] " " 00795 } elseif {[newline_count $cbetween] >= 2} { 00796 set index [$txtt index "[lindex $selected end]-[string length $cbetween]c"] 00797 $txtt insert $index $pbetween$pstr 00798 $txtt tag remove sel "$index+[string length $pbetween]c" [lindex $selected end] 00799 $txtt delete $startpos [lindex $selected 0] 00800 } else { 00801 $txtt insert [lindex $selected end] $pstr$pbetween 00802 $txtt delete $startpos [lindex $selected 0] 00803 } 00804 } 00805 paragraph { 00806 set startpos [get_index $txtt $type -dir prev -startpos [lindex $selected 0]] 00807 regexp {^(.*)(\s*)$} [$txtt get $startpos [lindex $selected 0]] -> str between 00808 $txtt insert [lindex $selected end] $between$str 00809 $txtt delete $startpos [lindex $selected 0] 00810 } 00811 node { 00812 if {[set range [select::node_prev_sibling $txtt [lindex $selected 0]]] ne ""} { 00813 set str [$txtt get {*}$range] 00814 set between [$txtt get [lindex $range 1] [lindex $selected 0]] 00815 $txtt insert [lindex $selected end] $between$str 00816 $txtt delete [lindex $range 0] [lindex $selected 0] 00817 } 00818 } 00819 } 00820 00821 # Otherwise, move the current line up by one line 00822 } else { 00823 set str [$txtt get "insert-1l linestart" "insert linestart"] 00824 $txtt delete "insert-1l linestart" "insert linestart" 00825 if {[$txtt compare "insert+1l linestart" == end]} { 00826 set str "\n[string trimright $str]" 00827 } 00828 $txtt insert "insert+1l linestart" $str 00829 } 00830 00831 # Create undo separator 00832 $txtt edit separator 00833 00834 } 00835 00836 ###################################################################### 00837 # Moves selected lines or the current line down by one line. 00838 proc transform_bubble_down {txtt} { 00839 00840 # Create undo separator 00841 $txtt edit separator 00842 00843 # If lines are selected, move all selected lines down one line 00844 if {[llength [set selected [$txtt tag ranges sel]]] > 0} { 00845 00846 switch [set type [select::get_type $txtt]] { 00847 none - 00848 line { 00849 foreach {end_range start_range} [lreverse $selected] { 00850 set str [$txtt get "$end_range+1l linestart" "$end_range+2l linestart"] 00851 $txtt delete "$end_range lineend" "$end_range+1l lineend" 00852 $txtt insert "$start_range linestart" $str 00853 } 00854 } 00855 sentence { 00856 set startpos [get_index $txtt $type -dir prev -startpos [lindex $selected 0]] 00857 set endpos [get_index $txtt $type -dir next -startpos "[lindex $selected end]+1 display chars"] 00858 regexp {^(.*?)(\s*)$} [$txtt get $startpos [lindex $selected 0]] -> pstr pbetween 00859 regexp {^(.*?)(\s*)$} [$txtt get [lindex $selected 0] [lindex $selected end]] -> cstr cbetween 00860 regexp {^(.*?)(\s*)$} [$txtt get [lindex $selected end] $endpos] -> astr abetween 00861 if {[newline_count $cbetween] >= 2} { 00862 set index [$txtt index "[lindex $selected 0]+[string length $cstr]c"] 00863 $txtt tag remove sel $index [lindex $selected end] 00864 if {$astr eq ""} { 00865 $txtt insert [lindex $selected end] $cstr sel 00866 } else { 00867 $txtt insert [lindex $selected end] "$cstr " sel 00868 } 00869 $txtt delete "[lindex $selected 0]-[string length $pbetween]c" $index 00870 } elseif {[newline_count $abetween] >= 2} { 00871 set index [$txtt index "[lindex $selected end]+[string length $astr]c"] 00872 $txtt tag add sel $index $endpos 00873 $txtt insert $index $cbetween {} $cstr sel 00874 $txtt delete [lindex $selected 0] [lindex $selected end] 00875 } elseif {$abetween eq ""} { 00876 $txtt delete "[lindex $selected end]-[string length $cbetween]c" $endpos 00877 $txtt insert [lindex $selected 0] $astr$cbetween 00878 } else { 00879 $txtt delete [lindex $selected end] $endpos 00880 $txtt insert [lindex $selected 0] $astr$cbetween 00881 } 00882 } 00883 paragraph { 00884 set endpos [get_index $txtt $type -dir next -startpos "[lindex $selected end]+1 display chars"] 00885 set str [string trimright [$txtt get [lindex $selected end] $endpos]] 00886 regexp {(\s*)$} [$txtt get {*}$selected] -> between 00887 $txtt delete [lindex $selected end] $endpos 00888 $txtt insert [lindex $selected 0] $str$between 00889 } 00890 node { 00891 if {[set range [select::node_next_sibling $txtt "[lindex $selected end]-1c"]] ne ""} { 00892 set str [$txtt get {*}$range] 00893 set between [$txtt get [lindex $selected end] [lindex $range 0]] 00894 $txtt delete [lindex $selected end] [lindex $range end] 00895 $txtt insert [lindex $selected 0] $str$between 00896 } 00897 } 00898 } 00899 00900 # Otherwise, move the current line down by one line 00901 } else { 00902 set str [$txtt get "insert+1l linestart" "insert+2l linestart"] 00903 $txtt delete "insert lineend" "insert+1l lineend" 00904 $txtt insert "insert linestart" $str 00905 } 00906 00907 # Create undo separator 00908 $txtt edit separator 00909 00910 } 00911 00912 ###################################################################### 00913 # Saves the given selection to the specified filename. If overwrite 00914 # is set to 1, the file will be written regardless of whether the file 00915 # already exists; otherwise, a message will be displayed that the file 00916 # already exists and the operation will end. 00917 proc save_selection {txt from to overwrite fname} { 00918 00919 if {!$overwrite && [file exists $fname]} { 00920 gui::set_info_message [::format "%s (%s)" [msgcat::mc "Filename already exists"] $fname] 00921 return 0 00922 } else { 00923 if {[catch { open $fname w } rc]} { 00924 gui::set_info_message [::format "%s %s" [msgcat::mc "Unable to write"] $fname] 00925 return 0 00926 } else { 00927 puts $rc [$txt get $from $to] 00928 close $rc 00929 gui::set_info_message [::format "%s (%s)" [msgcat::mc "File successfully written"] $fname] 00930 } 00931 } 00932 00933 return 1 00934 00935 } 00936 00937 ###################################################################### 00938 # Comments out the currently selected text. 00939 proc comment_text {txt} { 00940 00941 # Create a separator 00942 $txt edit separator 00943 00944 # Get the selection ranges 00945 set selected [$txt tag ranges sel] 00946 00947 # Get the comment syntax 00948 lassign [syntax::get_comments $txt] icomment lcomments bcomments 00949 00950 # Insert comment lines/blocks 00951 foreach {endpos startpos} [lreverse $selected] { 00952 if {[llength $icomment] == 1} { 00953 set i 0 00954 foreach line [split [$txt get $startpos $endpos] \n] { 00955 if {$i == 0} { 00956 $txt insert $startpos "[lindex $icomment 0]" 00957 $txt tag add sel $startpos "$startpos lineend" 00958 } else { 00959 $txt insert "$startpos+${i}l linestart" "[lindex $icomment 0]" 00960 } 00961 incr i 00962 } 00963 } else { 00964 $txt insert $endpos "[lindex $icomment 1]" 00965 $txt insert $startpos "[lindex $icomment 0]" 00966 if {[lindex [split $startpos .] 0] == [lindex [split $endpos .] 0]} { 00967 set endpos "$endpos+[expr [string length [lindex $icomment 0]] + [string length [lindex $icomment 1]]]c" 00968 } else { 00969 set endpos "$endpos+[string length [lindex $icomment 1]]c" 00970 } 00971 $txt tag add sel $startpos $endpos 00972 } 00973 } 00974 00975 # Create a separator 00976 $txt edit separator 00977 00978 } 00979 00980 ###################################################################### 00981 # Comments out the currently selected text in the current text widget. 00982 proc comment {} { 00983 00984 # Get the current text widget 00985 comment_text [gui::current_txt] 00986 00987 } 00988 00989 ###################################################################### 00990 # Uncomments out the currently selected text in the specified text 00991 # widget. 00992 proc uncomment_text {txt} { 00993 00994 # Create a separator 00995 $txt edit separator 00996 00997 # Get the selection ranges 00998 set selected [$txt tag ranges sel] 00999 01000 # Get the comment syntax 01001 lassign [syntax::get_comments $txt] icomment lcomments bcomments 01002 01003 # Get the comment syntax to remove 01004 set comments [join [eval concat $lcomments $bcomments] |] 01005 01006 # Strip out comment syntax 01007 foreach {endpos startpos} [lreverse $selected] { 01008 set linestart $startpos 01009 foreach line [split [$txt get $startpos $endpos] \n] { 01010 if {[regexp -indices -- "($comments)+?" $line -> com]} { 01011 set delstart [$txt index "$linestart+[lindex $com 0]c"] 01012 set delend [$txt index "$linestart+[expr [lindex $com 1] + 1]c"] 01013 $txt delete $delstart $delend 01014 } 01015 set linestart [$txt index "$linestart+1l linestart"] 01016 incr i 01017 } 01018 } 01019 01020 # Create a separator 01021 $txt edit separator 01022 01023 } 01024 01025 ###################################################################### 01026 # Uncomments out the currently selected text in the current text widget. 01027 proc uncomment {} { 01028 01029 # Get the current text widget 01030 uncomment_text [gui::current_txt] 01031 01032 } 01033 01034 ###################################################################### 01035 # Handles commenting/uncommenting either the currently selected code 01036 # or the current cursor. 01037 proc comment_toggle_text {txt} { 01038 01039 # Create a separator 01040 $txt edit separator 01041 01042 # Get various comments 01043 lassign [syntax::get_comments $txt] icomment lcomments bcomments 01044 01045 # Get the current selection 01046 set selected 1 01047 if {[llength [set ranges [$txt tag ranges sel]]] == 0} { 01048 if {[llength [set mcursors [$txt tag ranges mcursor]]] > 0} { 01049 foreach {startpos endpos} $mcursors { 01050 lappend ranges [$txt index "$startpos linestart"] [$txt index "$startpos lineend"] 01051 } 01052 } elseif {[lsearch [$txt tag names insert] __cComment] != -1} { 01053 lassign [$txt tag prevrange __cComment insert] startpos endpos 01054 if {[regexp "^[lindex $bcomments 0 0](.*)[lindex $bcomments 0 1]\$" [$txt get $startpos $endpos] -> str]} { 01055 $txt replace $startpos $endpos $str 01056 $txt edit separator 01057 } 01058 return 01059 } else { 01060 set ranges [list [$txt index "insert linestart"] [$txt index "insert lineend"]] 01061 } 01062 set selected 0 01063 } 01064 01065 # Iterate through each range 01066 foreach {endpos startpos} [lreverse $ranges] { 01067 if {![do_uncomment $txt $startpos $endpos]} { 01068 if {[llength $icomment] == 1} { 01069 set i 0 01070 foreach line [split [$txt get $startpos $endpos] \n] { 01071 if {$i == 0} { 01072 $txt insert $startpos "[lindex $icomment 0]" 01073 if {$selected} { 01074 $txt tag add sel $startpos "$startpos lineend" 01075 } 01076 } else { 01077 $txt insert "$startpos+${i}l linestart" "[lindex $icomment 0]" 01078 } 01079 incr i 01080 } 01081 } else { 01082 $txt insert $endpos "[lindex $icomment 1]" 01083 $txt insert $startpos "[lindex $icomment 0]" 01084 if {$selected} { 01085 if {[lindex [split $startpos .] 0] == [lindex [split $endpos .] 0]} { 01086 set endpos "$endpos+[expr [string length [lindex $icomment 0]] + [string length [lindex $icomment 1]]]c" 01087 } else { 01088 set endpos "$endpos+[string length [lindex $icomment 1]]c" 01089 } 01090 $txt tag add sel $startpos $endpos 01091 } 01092 } 01093 } 01094 } 01095 01096 # Create a separator 01097 $txt edit separator 01098 01099 } 01100 01101 ###################################################################### 01102 # Toggles the toggle status of the currently selected lines in the current 01103 # text widget. 01104 proc comment_toggle {} { 01105 01106 # Get the current text widget 01107 comment_toggle_text [gui::current_txt] 01108 01109 } 01110 01111 ###################################################################### 01112 # Determines if the given range can be uncommented. If so, performs 01113 # the uncomment and returns 1; otherwise, returns 0. 01114 proc do_uncomment {txt startpos endpos} { 01115 01116 set retval 0 01117 01118 # Get the comment syntax 01119 lassign [syntax::get_comments $txt] icomment lcomments bcomments 01120 01121 # Get the comment syntax to remove 01122 set comments [join [eval concat $lcomments $bcomments] |] 01123 01124 set linestart $startpos 01125 foreach line [split [$txt get $startpos $endpos] \n] { 01126 if {[regexp -indices -- "($comments)+?" $line -> com]} { 01127 set delstart [$txt index "$linestart+[lindex $com 0]c"] 01128 set delend [$txt index "$linestart+[expr [lindex $com 1] + 1]c"] 01129 $txt delete $delstart $delend 01130 set retval 1 01131 } 01132 set linestart [$txt index "$linestart+1l linestart"] 01133 incr i 01134 } 01135 01136 return $retval 01137 01138 } 01139 01140 ###################################################################### 01141 # Perform indentation on a specified range. 01142 proc do_indent {txtt startpos endpos} { 01143 01144 # Get the indent spacing 01145 set indent_str [string repeat " " [indent::get_shiftwidth $txtt]] 01146 01147 while {[$txtt index "$startpos linestart"] <= [$txtt index "$endpos linestart"]} { 01148 $txtt insert "$startpos linestart" $indent_str 01149 set startpos [$txtt index "$startpos linestart+1l"] 01150 } 01151 01152 } 01153 01154 ###################################################################### 01155 # Perform unindentation on a specified range. 01156 proc do_unindent {txtt startpos endpos} { 01157 01158 # Get the indent spacing 01159 set unindent_str [string repeat " " [indent::get_shiftwidth $txtt]] 01160 set unindent_len [string length $unindent_str] 01161 01162 while {[$txtt index "$startpos linestart"] <= [$txtt index "$endpos linestart"]} { 01163 if {[regexp "^$unindent_str" [$txtt get "$startpos linestart" "$startpos lineend"]]} { 01164 $txtt delete "$startpos linestart" "$startpos linestart+${unindent_len}c" 01165 } 01166 set startpos [$txtt index "$startpos linestart+1l"] 01167 } 01168 01169 } 01170 01171 ###################################################################### 01172 # If text is selected, performs one level of indentation. Returns 1 if 01173 # text was selected; otherwise, returns 0. 01174 proc indent_selected {txtt} { 01175 01176 if {[llength [set range [$txtt tag ranges sel]]] > 0} { 01177 foreach {endpos startpos} [lreverse $range] { 01178 do_indent $txtt $startpos $endpos 01179 } 01180 ::tk::TextSetCursor $txtt [get_index $txtt firstchar -startpos $startpos -num 0] 01181 return 1 01182 } 01183 01184 return 0 01185 01186 } 01187 01188 ###################################################################### 01189 # Indents the selected text of the current text widget by one 01190 # indentation level. 01191 proc indent {txtt {startpos "insert"} {endpos "insert"}} { 01192 01193 if {![indent_selected $txtt]} { 01194 do_indent $txtt $startpos $endpos 01195 ::tk::TextSetCursor $txtt [get_index $txtt firstchar -startpos $startpos -num 0] 01196 } 01197 01198 } 01199 01200 ###################################################################### 01201 # If text is selected, unindents the selected lines by one level and 01202 # return a value of 1; otherwise, return a value of 0. 01203 proc unindent_selected {txtt} { 01204 01205 if {[llength [set range [$txtt tag ranges sel]]] > 0} { 01206 foreach {endpos startpos} [lreverse $range] { 01207 do_unindent $txtt $startpos $endpos 01208 } 01209 ::tk::TextSetCursor $txtt [get_index $txtt firstchar -startpos $startpos -num 0] 01210 return 1 01211 } 01212 01213 return 0 01214 01215 } 01216 01217 ###################################################################### 01218 # Unindents the selected text of the current text widget by one 01219 # indentation level. 01220 proc unindent {txtt {startpos "insert"} {endpos "insert"}} { 01221 01222 if {![unindent_selected $txtt]} { 01223 do_unindent $txtt $startpos $endpos 01224 ::tk::TextSetCursor $txtt [get_index $txtt firstchar -startpos $startpos -num 0] 01225 } 01226 01227 } 01228 01229 ###################################################################### 01230 # Replaces the current line with the output contents of it as a script. 01231 proc replace_line_with_script {} { 01232 01233 # Get the current text widget 01234 set txt [gui::current_txt] 01235 01236 # Get the current line 01237 set cmd [$txt get "insert linestart" "insert lineend"] 01238 01239 # Execute the line text 01240 catch { exec -ignorestderr {*}$cmd } rc 01241 01242 # Replace the line with the given text 01243 $txt replace "insert linestart" "insert lineend" $rc 01244 01245 } 01246 01247 ###################################################################### 01248 # Returns true if the current line is empty; otherwise, returns false. 01249 proc current_line_empty {} { 01250 01251 # Get the current text widget 01252 set txt [gui::current_txt] 01253 01254 return [expr {[$txt get "insert linestart" "insert lineend"] eq ""}] 01255 01256 } 01257 01258 ###################################################################### 01259 # Aligns the current cursors such that all cursors will be aligned to 01260 # the cursor closest to the start of its line. 01261 proc align_cursors {} { 01262 01263 # Get the current text widget 01264 set txt [gui::current_txt] 01265 01266 # Align multicursors only 01267 multicursor::align $txt 01268 01269 } 01270 01271 ###################################################################### 01272 # Aligns the current cursors, keeping each multicursor locked to its 01273 # text. 01274 proc align_cursors_and_text {} { 01275 01276 # Get the current text widget 01277 set txt [gui::current_txt] 01278 01279 # Align multicursors 01280 multicursor::align_with_text $txt 01281 01282 } 01283 01284 ###################################################################### 01285 # Inserts an enumeration when in multicursor mode. 01286 proc insert_enumeration {} { 01287 01288 # Get the current text widget 01289 set txt [gui::current_txt] 01290 01291 # Perform the insertion 01292 gui::insert_numbers $txt 01293 01294 } 01295 01296 ###################################################################### 01297 # Jumps to the given line number. 01298 proc jump_to_line {txt linenum} { 01299 01300 # Set the insertion cursor to the given line number 01301 ::tk::TextSetCursor $txt $linenum 01302 01303 # Adjust the insertion cursor 01304 vim::adjust_insert $txt 01305 01306 } 01307 01308 ###################################################################### 01309 # Returns the index of the character located num chars in the direction 01310 # specified from the starting index. 01311 proc get_char {txt dir {num 1} {start insert}} { 01312 01313 if {$dir eq "next"} { 01314 01315 while {($num > 0) && [$txt compare $start < end-2c]} { 01316 if {[set line_chars [$txt count -displaychars $start "$start lineend"]] == 0} { 01317 set start [$txt index "$start+1 display lines"] 01318 set start "$start linestart" 01319 incr num -1 01320 } elseif {$line_chars <= $num} { 01321 set start [$txt index "$start+1 display lines"] 01322 set start "$start linestart" 01323 incr num -$line_chars 01324 } else { 01325 set start "$start+$num display chars" 01326 set num 0 01327 } 01328 } 01329 01330 return [$txt index $start] 01331 01332 } else { 01333 01334 set first 1 01335 while {($num > 0) && [$txt compare $start > 1.0]} { 01336 if {([set line_chars [$txt count -displaychars "$start linestart" $start]] == 0) && !$first} { 01337 if {[incr num -1] > 0} { 01338 set start [$txt index "$start-1 display lines"] 01339 set start "$start lineend" 01340 } 01341 } elseif {$line_chars < $num} { 01342 set start [$txt index "$start-1 display lines"] 01343 set start "$start lineend" 01344 incr num -$line_chars 01345 } else { 01346 set start "$start-$num display chars" 01347 set num 0 01348 } 01349 set first 0 01350 } 01351 01352 return [$txt index $start] 01353 01354 } 01355 01356 } 01357 01358 ###################################################################### 01359 # Returns the index of the beginning next/previous word. If num is 01360 # given a value > 1, the procedure will return the beginning index of 01361 # the next/previous num'th word. If no word was found, return the index 01362 # of the current word. 01363 proc get_wordstart {txt dir {num 1} {start insert} {exclusive 0}} { 01364 01365 lassign [split [$txt index $start] .] curr_row curr_col 01366 01367 if {$dir eq "next"} { 01368 01369 while {1} { 01370 01371 set line [$txt get -displaychars $curr_row.0 $curr_row.end] 01372 01373 while {1} { 01374 set char [string index $line $curr_col] 01375 if {[set isword [string is wordchar $char]] && [regexp -indices -start $curr_col -- {\W} $line index]} { 01376 set curr_col [lindex $index 1] 01377 } elseif {[set isspace [string is space $char]] && [regexp -indices -start $curr_col -- {\S} $line index]} { 01378 set curr_col [lindex $index 1] 01379 } elseif {!$isword && !$isspace && [regexp -indices -start $curr_col -- {[\w\s]} $line index]} { 01380 set curr_col [lindex $index 1] 01381 } else { 01382 break 01383 } 01384 if {![string is space [string index $line $curr_col]] && ([incr num -1] == 0)} { 01385 return [$txt index "$curr_row.0 + $curr_col display chars"] 01386 } 01387 } 01388 01389 lassign [split [$txt index "$curr_row.end + 1 display chars"] .] curr_row curr_col 01390 01391 if {![$txt compare $curr_row.$curr_col < end]} { 01392 return [$txt index "end-1 display chars"] 01393 } elseif {(![string is space [$txt index $curr_row.$curr_col]] || [$txt compare $curr_row.0 == $curr_row.end]) && ([incr num -1] == 0)} { 01394 return [$txt index "$curr_row.0 + $curr_col display chars"] 01395 } 01396 01397 } 01398 01399 } else { 01400 01401 while {1} { 01402 01403 set line [$txt get -displaychars $curr_row.0 $curr_row.$curr_col] 01404 01405 while {1} { 01406 if {[regexp -indices -- {(\w+|\s+|[^\w\s]+)$} [string range $line 0 [expr $curr_col - 1]] index]} { 01407 set curr_col [lindex $index 0] 01408 } else { 01409 break 01410 } 01411 if {![string is space [string index $line $curr_col]] && ([incr num -1] == 0)} { 01412 return [$txt index "$curr_row.0 + $curr_col display chars"] 01413 } 01414 } 01415 01416 lassign [split [$txt index "$curr_row.0 - 1 display chars"] .] curr_row curr_col 01417 01418 if {![$txt compare $curr_row.$curr_col > 1.0]} { 01419 return "1.0" 01420 } elseif {(![string is space [string index $line $curr_col]] || ($curr_col == 0)) && ([incr num -1] == 0)} { 01421 return [$txt index "$curr_row.0 + $curr_col display chars"] 01422 } 01423 01424 } 01425 01426 } 01427 01428 } 01429 01430 ###################################################################### 01431 # Returns the index of the ending next/previous word. If num is 01432 # given a value > 1, the procedure will return the beginning index of 01433 # the next/previous num'th word. If no word was found, return the index 01434 # of the current word. 01435 proc get_wordend {txt dir {num 1} {start insert} {exclusive 0}} { 01436 01437 lassign [split [$txt index $start] .] curr_row curr_col 01438 01439 if {$dir eq "next"} { 01440 01441 while {1} { 01442 01443 set line [$txt get -displaychars $curr_row.0 $curr_row.end] 01444 01445 while {1} { 01446 if {[regexp -indices -start [expr $curr_col + 1] -- {(\w+|\s+|[^\w\s]+)} $line index]} { 01447 set curr_col [lindex $index 1] 01448 } else { 01449 break 01450 } 01451 if {![string is space [string index $line $curr_col]] && ([incr num -1] == 0)} { 01452 return [$txt index "$curr_row.0 + $curr_col display chars"] 01453 } 01454 } 01455 01456 lassign [split [$txt index "$curr_row.end + 1 display chars"] .] curr_row curr_col 01457 01458 if {![$txt compare $curr_row.$curr_col < end]} { 01459 return [$txt index "end-1 display chars"] 01460 } 01461 01462 } 01463 01464 } else { 01465 01466 while {1} { 01467 01468 set line [$txt get -displaychars $curr_row.0 $curr_row.end] 01469 01470 while {1} { 01471 set char [string index $line $curr_col] 01472 if {[set isword [string is wordchar $char]] && [regexp -indices -- {\W\w*$} [string range $line 0 $curr_col] index]} { 01473 set curr_col [lindex $index 0] 01474 } elseif {[set isspace [string is space $char]] && [regexp -indices -- {\S\s*$} [string range $line 0 $curr_col] index]} { 01475 set curr_col [lindex $index 0] 01476 } elseif {!$isword && !$isspace && [regexp -indices -- {[\w\s][^\w\s]*$} [string range $line 0 $curr_col] index]} { 01477 set curr_col [lindex $index 0] 01478 } else { 01479 break 01480 } 01481 if {![string is space [string index $line $curr_col]] && ([incr num -1] == 0)} { 01482 return [$txt index "$curr_row.0 + $curr_col display chars"] 01483 } 01484 } 01485 01486 lassign [split [$txt index "$curr_row.0 - 1 display chars"] .] curr_row curr_col 01487 01488 if {![$txt compare $curr_row.$curr_col > 1.0]} { 01489 return "1.0" 01490 } elseif {![string is space [$txt index $curr_row.$curr_col]] && ([incr num -1] == 0)} { 01491 return [$txt index "$curr_row.0 + $curr_col display chars"] 01492 } 01493 01494 } 01495 01496 } 01497 01498 } 01499 01500 ###################################################################### 01501 # Returns the index of the start of a Vim WORD (any character that is 01502 # preceded by whitespace, the first character of a line, or an empty 01503 # line. 01504 proc get_WORDstart {txtt dir {num 1} {start insert} {exclusive 0}} { 01505 01506 if {$dir eq "next"} { 01507 set diropt "-forwards" 01508 set startpos $start 01509 set endpos "end" 01510 set suffix "+1c" 01511 } else { 01512 set diropt "-backwards" 01513 set startpos "$start-1c" 01514 set endpos "1.0" 01515 set suffix "" 01516 } 01517 01518 while {[set index [$txtt search $diropt -regexp -- {\s\S|\n\n} $startpos $endpos]] ne ""} { 01519 if {[incr num -1] == 0} { 01520 return [$txtt index $index+1c] 01521 } 01522 set startpos "$index$suffix" 01523 } 01524 01525 return $start 01526 01527 } 01528 01529 ###################################################################### 01530 # Returns the index of the end of a Vim WORD (any character that is 01531 # succeeded by whitespace, the last character of a line or an empty line. 01532 proc get_WORDend {txtt dir {num 1} {start insert} {exclusive 0}} { 01533 01534 if {$dir eq "next"} { 01535 set diropt "-forwards" 01536 set startpos "$start+1c" 01537 set endpos "end" 01538 set suffix "+1c" 01539 } else { 01540 set diropt "-backwards" 01541 set startpos $start 01542 set endpos "1.0" 01543 set suffix "" 01544 } 01545 01546 while {[set index [$txtt search $diropt -regexp -- {\S\s|\n\n} $startpos $endpos]] ne ""} { 01547 if {[$txtt get $index] eq "\n"} { 01548 if {[incr num -1] == 0} { 01549 return [$txtt index $index+1c] 01550 } 01551 } else { 01552 if {[incr num -1] == 0} { 01553 return [$txtt index $index] 01554 } 01555 } 01556 set startpos "$index$suffix" 01557 } 01558 01559 return $start 01560 01561 } 01562 01563 ###################################################################### 01564 # Returns the starting index of the given character. 01565 proc find_char {txtt dir char num startpos exclusive} { 01566 01567 # Perform the character search 01568 if {$dir eq "next"} { 01569 set indices [$txtt search -all -- $char "$startpos+1c" "$startpos lineend"] 01570 if {[set index [lindex $indices [expr $num - 1]]] eq ""} { 01571 set index "insert" 01572 } elseif {$exclusive} { 01573 set index "$index-1c" 01574 } 01575 } else { 01576 set indices [$txtt search -all -- $char "$startpos linestart" insert] 01577 if {[set index [lindex $indices end-[expr $num - 1]]] eq ""} { 01578 set index "insert" 01579 } elseif {$exclusive} { 01580 set index "$index+1c" 01581 } 01582 } 01583 01584 return $index 01585 01586 } 01587 01588 ###################################################################### 01589 # Returns the exclusive position of the given character search. 01590 proc between_char {txtt dir char {startpos "insert"}} { 01591 01592 array set pairs { 01593 \{ {\\\} L} 01594 \} {\\\{ R} 01595 \( {\\\) L} 01596 \) {\\\( R} 01597 \[ {\\\] L} 01598 \] {\\\[ R} 01599 < {> L} 01600 > {< R} 01601 } 01602 01603 # Get the matching character 01604 if {[info exists pairs($char)]} { 01605 if {[lindex $pairs($char) 1] eq "R"} { 01606 if {$dir eq "prev"} { 01607 set index [gui::find_match_pair $txtt [lindex $pairs($char) 0] \\$char -backwards] 01608 } else { 01609 set index [gui::find_match_pair $txtt \\$char [lindex $pairs($char) 0] -forwards] 01610 } 01611 } else { 01612 if {$dir eq "prev"} { 01613 set index [gui::find_match_pair $txtt \\$char [lindex $pairs($char) 0] -backwards] 01614 } else { 01615 set index [gui::find_match_pair $txtt [lindex $pairs($char) 0] \\$char -forwards] 01616 } 01617 } 01618 } else { 01619 if {$dir eq "prev"} { 01620 set index [gui::find_match_char $txtt $char -backwards] 01621 } else { 01622 set index [gui::find_match_char $txtt $char -forwards] 01623 } 01624 } 01625 01626 if {$index == -1} { 01627 return [expr {($dir eq "prev") ? 1.0 : "end-1c"}] 01628 } else { 01629 return [expr {($dir eq "prev") ? "$index+1c" : $index}] 01630 } 01631 01632 } 01633 01634 ###################################################################### 01635 # Gets the previous or next sentence as defined by the Vim specification. 01636 proc get_sentence {txtt dir num {startpos "insert"}} { 01637 01638 variable patterns 01639 01640 # Search for the end of the previous sentence 01641 set index [$txtt search -backwards -count lengths -regexp -- $patterns(sentence) $startpos 1.0] 01642 set beginpos "1.0" 01643 set endpos "end-1c" 01644 01645 # If the startpos is within a comment block and the found index lies outside of that 01646 # block, set the sentence starting point on the first non-whitespace character within the 01647 # comment block. 01648 if {[set comment [ctext::commentCharRanges [winfo parent $txtt] $startpos]] ne ""} { 01649 lassign [lrange $comment 1 2] beginpos endpos 01650 if {($index ne "") && [$txtt compare $index < [lindex $comment 1]]} { 01651 set index "" 01652 } 01653 01654 # If the end of the found sentence is within a comment block, set the beginning position 01655 # to the end of that comment and clear the index. 01656 } elseif {($index ne "") && ([set comment [ctext::commentCharRanges [winfo parent $txtt] $index]] ne "")} { 01657 set beginpos [lindex $comment end] 01658 set index "" 01659 } 01660 01661 if {$dir eq "next"} { 01662 01663 # If we could not find the end of a previous sentence, find the first 01664 # non-whitespace character in the file and if it is after the startpos, 01665 # return the index. 01666 if {($index eq "") && ([set index [$txtt search -forwards -count lengths -regexp -- {\S} $beginpos $endpos]] ne "")} { 01667 if {[$txtt compare $index > $startpos] && ([incr num -1] == 0)} { 01668 return $index 01669 } 01670 set index "" 01671 } 01672 01673 # If the insertion cursor is just before the beginning of the sentence. 01674 if {($index ne "") && [$txtt compare $startpos < "$index+[expr [lindex $lengths 0] - 1]c"]} { 01675 set startpos $index 01676 } 01677 01678 while {[set index [$txtt search -forwards -count lengths -regexp -- $patterns(sentence) $startpos $endpos]] ne ""} { 01679 set startpos [$txtt index "$index+[expr [lindex $lengths 0] - 1]c"] 01680 if {[incr num -1] == 0} { 01681 return $startpos 01682 } 01683 } 01684 01685 return $endpos 01686 01687 } else { 01688 01689 # If the insertion cursor is between sentences, adjust the starting position 01690 if {($index ne "") && [$txtt compare $startpos <= "$index+[expr [lindex $lengths 0] - 1]c"]} { 01691 set startpos $index 01692 } 01693 01694 while {[set index [$txtt search -backwards -count lengths -regexp -- $patterns(sentence) $startpos-1c $beginpos]] ne ""} { 01695 set startpos $index 01696 if {[incr num -1] == 0} { 01697 return [$txtt index "$index+[expr [lindex $lengths 0] - 1]c"] 01698 } 01699 } 01700 01701 if {([incr num -1] == 0) && \ 01702 ([set index [$txtt search -forwards -regexp -- {\S} $beginpos $endpos]] ne "") && \ 01703 ([$txtt compare $index < $startpos])} { 01704 return $index 01705 } else { 01706 return $beginpos 01707 } 01708 01709 } 01710 01711 } 01712 01713 ###################################################################### 01714 # Find the next or previous paragraph. 01715 proc get_paragraph {txtt dir num {start insert}} { 01716 01717 if {$dir eq "next"} { 01718 01719 set nl 0 01720 while {[$txtt compare $start < end-1c]} { 01721 if {([$txtt get "$start linestart" "$start lineend"] eq "") || \ 01722 ([lsearch [$txtt tag names $start] dspace] != -1)} { 01723 set nl 1 01724 } elseif {$nl && ([incr num -1] == 0)} { 01725 return "$start linestart" 01726 } else { 01727 set nl 0 01728 } 01729 set start [$txtt index "$start+1 display lines"] 01730 } 01731 01732 return [$txtt index end-1c] 01733 01734 } else { 01735 01736 set last_start "end" 01737 01738 # If the start position is in the first column adjust the starting 01739 # line to the line above to avoid matching ourselves 01740 if {[$txtt compare $start == "$start linestart"]} { 01741 set last_start $start 01742 set start [$txtt index "$start-1 display lines"] 01743 } 01744 01745 set nl 1 01746 while {[$txtt compare $start < $last_start]} { 01747 if {([$txtt get "$start linestart" "$start lineend"] ne "") && \ 01748 ([lsearch [$txtt tag names $start] dspace] == -1)} { 01749 set nl 0 01750 } elseif {!$nl && ([incr num -1] == 0)} { 01751 return [$txtt index "$start+1 display lines linestart"] 01752 } else { 01753 set nl 1 01754 } 01755 set last_start $start 01756 set start [$txtt index "$start-1 display lines"] 01757 } 01758 01759 if {(([$txtt get "$start linestart" "$start lineend"] eq "") || \ 01760 ([lsearch [$txtt tag names $start] dspace] != -1)) && !$nl && \ 01761 ([incr num -1] == 0)} { 01762 return [$txtt index "$start+1 display lines linestart"] 01763 } else { 01764 return 1.0 01765 } 01766 01767 } 01768 01769 } 01770 01771 ###################################################################### 01772 # Returns the index of the requested permission. 01773 # - left Move the cursor to the left on the current line 01774 # - right Move the cursor to the right on the current line 01775 # - first First line in file 01776 # - last Last line in file 01777 # - nextchar Next character 01778 # - prevchar Previous character 01779 # - firstchar First character of the line 01780 # - lastchar Last character of the line 01781 # - nextword Beginning of next word 01782 # - prevword Beginning of previous word 01783 # - nextfirst Beginning of first word in next line 01784 # - prevfirst Beginning of first word in previous line 01785 # - column Move the cursor to the specified column in the current line 01786 # - linestart Start of current line 01787 # - lineend End of current line 01788 # - screentop Top of current screen 01789 # - screenmid Middle of current screen 01790 # - screenbot Bottom of current screen 01791 proc get_index {txtt position args} { 01792 01793 variable patterns 01794 01795 array set opts { 01796 -dir "next" 01797 -startpos "insert" 01798 -num 1 01799 -char "" 01800 -exclusive 0 01801 -column "" 01802 -adjust "" 01803 -forceadjust "" 01804 } 01805 array set opts $args 01806 01807 # Create a default index to use 01808 set index $opts(-startpos) 01809 01810 # Get the new cursor position 01811 switch $position { 01812 left { 01813 if {[$txtt compare "$opts(-startpos) display linestart" > "$opts(-startpos)-$opts(-num) display chars"]} { 01814 set index "$opts(-startpos) display linestart" 01815 } else { 01816 set index "$opts(-startpos)-$opts(-num) display chars" 01817 } 01818 } 01819 right { 01820 if {[$txtt compare "$opts(-startpos) display lineend" < "$opts(-startpos)+$opts(-num) display chars"]} { 01821 set index "$opts(-startpos) display lineend" 01822 } else { 01823 set index "$opts(-startpos)+$opts(-num) display chars" 01824 } 01825 } 01826 up { 01827 if {[set $opts(-column)] eq ""} { 01828 set $opts(-column) [lindex [split [$txtt index $opts(-startpos)] .] 1] 01829 } 01830 set index $opts(-startpos) 01831 for {set i 0} {$i < $opts(-num)} {incr i} { 01832 set index [$txtt index "$index linestart-1 display lines"] 01833 } 01834 set index [lindex [split $index .] 0].[set $opts(-column)] 01835 } 01836 down { 01837 if {[set $opts(-column)] eq ""} { 01838 set $opts(-column) [lindex [split [$txtt index $opts(-startpos)] .] 1] 01839 } 01840 set index $opts(-startpos) 01841 for {set i 0} {$i < $opts(-num)} {incr i} { 01842 if {[$txtt compare [set index [$txtt index "$index lineend+1 display lines"]] == end]} { 01843 set index [$txtt index "end-1c"] 01844 break 01845 } 01846 } 01847 set index [lindex [split $index .] 0].[set $opts(-column)] 01848 } 01849 first { 01850 if {[$txtt get -displaychars 1.0] eq ""} { 01851 set index "1.0+1 display chars" 01852 } else { 01853 set index "1.0" 01854 } 01855 } 01856 last { set index "end" } 01857 char { set index [get_char $txtt $opts(-dir) $opts(-num) $opts(-startpos)] } 01858 dchar { 01859 if {$opts(-dir) eq "next"} { 01860 set index "$opts(-startpos)+$opts(-num) display chars" 01861 } else { 01862 set index "$opts(-startpos)-$opts(-num) display chars" 01863 } 01864 } 01865 findchar { set index [find_char $txtt $opts(-dir) $opts(-char) $opts(-num) $opts(-startpos) $opts(-exclusive)] } 01866 betweenchar { set index [between_char $txtt $opts(-dir) $opts(-char) $opts(-startpos)] } 01867 firstchar { 01868 if {$opts(-num) == 0} { 01869 set index $opts(-startpos) 01870 } elseif {$opts(-dir) eq "next"} { 01871 if {[$txtt compare [set index [$txtt index "$opts(-startpos)+$opts(-num) display lines"]] == end]} { 01872 set index [$txtt index "$index-1 display lines"] 01873 } 01874 } else { 01875 set index [$txtt index "$opts(-startpos)-$opts(-num) display lines"] 01876 } 01877 if {[lsearch [$txtt tag names "$index linestart"] __prewhite] != -1} { 01878 set index [lindex [$txtt tag nextrange __prewhite "$index linestart"] 1]-1c 01879 } else { 01880 set index "$index lineend" 01881 } 01882 } 01883 lastchar { 01884 set line [expr [lindex [split [$txtt index $opts(-startpos)] .] 0] + ($opts(-num) - 1)] 01885 set index "$line.0+[string length [string trimright [$txtt get $line.0 $line.end]]]c" 01886 } 01887 wordstart { set index [get_wordstart $txtt $opts(-dir) $opts(-num) $opts(-startpos) $opts(-exclusive)] } 01888 wordend { set index [get_wordend $txtt $opts(-dir) $opts(-num) $opts(-startpos) $opts(-exclusive)] } 01889 WORDstart { set index [get_WORDstart $txtt $opts(-dir) $opts(-num) $opts(-startpos) $opts(-exclusive)] } 01890 WORDend { set index [get_WORDend $txtt $opts(-dir) $opts(-num) $opts(-startpos) $opts(-exclusive)] } 01891 column { set index [lindex [split [$txtt index $opts(-startpos)] .] 0].[expr $opts(-num) - 1] } 01892 linenum { 01893 if {[lsearch [$txtt tag names "$opts(-num).0"] __prewhite] != -1} { 01894 set index [lindex [$txtt tag nextrange __prewhite "$opts(-num).0"] 1]-1c 01895 } else { 01896 set index "$opts(-num).0 lineend" 01897 } 01898 } 01899 linestart { 01900 if {$opts(-num) > 1} { 01901 if {[$txtt compare [set index [$txtt index "$opts(-startpos)+[expr $opts(-num) - 1] display lines linestart"]] == end]} { 01902 set index "end" 01903 } else { 01904 set index "$index+1 display chars" 01905 } 01906 } else { 01907 set index [$txtt index "$opts(-startpos) linestart+1 display chars"] 01908 } 01909 if {[$txtt compare "$index-1 display chars" >= "$index linestart"]} { 01910 set index "$index-1 display chars" 01911 } 01912 } 01913 lineend { 01914 if {$opts(-num) == 1} { 01915 set index "$opts(-startpos) lineend" 01916 } else { 01917 set index [$txtt index "$opts(-startpos)+[expr $opts(-num) - 1] display lines"] 01918 set index "$index lineend" 01919 } 01920 } 01921 dispstart { set index "@0,[lindex [$txtt bbox $opts(-startpos)] 1]" } 01922 dispmid { set index "@[expr [winfo width $txtt] / 2],[lindex [$txtt bbox $opts(-startpos)] 1]" } 01923 dispend { set index "@[winfo width $txtt],[lindex [$txtt bbox $opts(-startpos)] 0]" } 01924 sentence { set index [get_sentence $txtt $opts(-dir) $opts(-num) $opts(-startpos)] } 01925 paragraph { set index [get_paragraph $txtt $opts(-dir) $opts(-num) $opts(-startpos)] } 01926 screentop { set index "@0,0" } 01927 screenmid { set index "@0,[expr [winfo height $txtt] / 2]" } 01928 screenbot { set index "@0,[winfo height $txtt]" } 01929 numberstart { 01930 if {[regexp $patterns(pnumber) [$txtt get "$opts(-startpos) linestart" $opts(-startpos)] match]} { 01931 set index "$opts(-startpos)-[string length $match]c" 01932 } 01933 } 01934 numberend { 01935 if {[regexp $patterns(nnumber) [$txtt get $opts(-startpos) "$opts(-startpos) lineend"] match]} { 01936 set index "$opts(-startpos)+[expr [string length $match] - 1]c" 01937 } 01938 } 01939 spacestart { 01940 if {[regexp $patterns(pspace) [$txtt get "$opts(-startpos) linestart" $opts(-startpos)] match]} { 01941 set index "$opts(-startpos)-[string length $match]c" 01942 } 01943 } 01944 spaceend { 01945 if {[regexp $patterns(nspace) [$txtt get $opts(-startpos) "$opts(-startpos) lineend"] match]} { 01946 set index "$opts(-startpos)+[expr [string length $match] - 1]c" 01947 } 01948 } 01949 tagstart { 01950 set insert [$txtt index insert] 01951 while {[set ranges [emmet::get_node_range [winfo parent $txtt]]] ne ""} { 01952 if {[incr opts(-num) -1] == 0} { 01953 set index [expr {$opts(-exclusive) ? [lindex $ranges 1] : [lindex $ranges 0]}] 01954 break 01955 } else { 01956 $txtt mark set insert "[lindex $ranges 0]-1c" 01957 } 01958 } 01959 $txtt mark set insert $insert 01960 } 01961 tagend { 01962 set insert [$txtt index insert] 01963 while {[set ranges [emmet::get_node_range [winfo parent $txtt]]] ne ""} { 01964 if {[incr opts(-num) -1] == 0} { 01965 set index [expr {$opts(-exclusive) ? [lindex $ranges 2] : [lindex $ranges 3]}] 01966 break 01967 } else { 01968 $txtt mark set insert "[lindex $ranges 0]-1c" 01969 } 01970 } 01971 $txtt mark set insert $insert 01972 } 01973 } 01974 01975 # Make any necessary adjustments, if needed 01976 if {$opts(-forceadjust) ne ""} { 01977 set index [$txtt index "$index$opts(-forceadjust)"] 01978 } elseif {($index ne $opts(-startpos)) && ($opts(-adjust) ne "")} { 01979 set index [$txtt index "$index$opts(-adjust)"] 01980 } 01981 01982 return $index 01983 01984 } 01985 01986 ###################################################################### 01987 # Handles word/WORD range motions. 01988 proc get_range_word {txtt type num inner adjust {cursor insert}} { 01989 01990 if {$inner} { 01991 01992 # Get the starting position of the selection 01993 if {[string is space [$txtt get $cursor]]} { 01994 set startpos [get_index $txtt spacestart -dir prev -startpos "$cursor+1c"] 01995 } else { 01996 set startpos [get_index $txtt ${type}start -dir prev -startpos "$cursor+1c"] 01997 } 01998 01999 # Count spaces and non-spaces 02000 set endpos $cursor 02001 for {set i 0} {$i < $num} {incr i} { 02002 if {$type eq "WORD"} { 02003 set endpos [$txtt index "$endpos+1c"] 02004 } 02005 if {[string is space [$txtt get $endpos]]} { 02006 set endpos [get_index $txtt spaceend -dir next -startpos $endpos] 02007 } else { 02008 set endpos [get_index $txtt ${type}end -dir next -startpos $endpos] 02009 } 02010 } 02011 02012 } else { 02013 02014 set endpos [get_index $txtt ${type}end -dir next -num $num -startpos [expr {($type eq "word") ? $cursor : "$cursor-1c"}]] 02015 02016 # If the cursor is within a space, make the startpos be the start of the space 02017 if {[string is space [$txtt get $cursor]]} { 02018 set startpos [get_index $txtt spacestart -dir prev -startpos "$cursor+1c"] 02019 02020 # Otherwise, the insertion cursor is within a word, if the character following 02021 # the end of the word is a space, the start is the start of the word while the end is 02022 # the whitspace after the word. 02023 } elseif {[$txtt compare "$endpos+1c" < "$endpos lineend"] && [string is space [$txtt get "$endpos+1c"]]} { 02024 set startpos [get_index $txtt ${type}start -dir prev -startpos "$cursor+1c"] 02025 set endpos [get_index $txtt spaceend -dir next -startpos "$endpos+1c"] 02026 02027 # Otherwise, set the start of the selection to the be the start of the preceding 02028 # whitespace. 02029 } else { 02030 set startpos [get_index $txtt ${type}start -dir prev -startpos "$cursor+1c"] 02031 if {[$txtt compare $startpos > "$startpos linestart"] && [string is space [$txtt get "$startpos-1c"]]} { 02032 set startpos [get_index $txtt spacestart -dir prev -startpos "$startpos-1c"] 02033 } 02034 } 02035 02036 } 02037 02038 return [list $startpos [$txtt index "$endpos$adjust"]] 02039 02040 } 02041 02042 ###################################################################### 02043 # Handles WORD range motion. 02044 proc get_range_WORD {txtt num inner adjust {cursor insert}} { 02045 02046 if {[string is space [$txtt get $cursor]]} { 02047 set pos_list [list [get_index $txtt spacestart -dir prev -startpos "$cursor+1c"] [get_index $txtt spaceend -dir next -adjust "-1c"]] 02048 } else { 02049 set pos_list [list [get_index $txtt $start -dir prev -startpos "$cursor+1c"] [get_index $txtt $end -dir next -num $num]] 02050 } 02051 02052 if {!$inner} { 02053 set index [$txtt search -forwards -regexp -- {\S} "[lindex $pos_list 1]+1c" "[lindex $pos_list 1] lineend"] 02054 if {($index ne "") && [$txtt compare "[lindex $pos_list 1]+1c" != $index]} { 02055 lset pos_list 1 [$txtt index "$index-1c"] 02056 } else { 02057 set index [$txtt search -backwards -regexp -- {\S} [lindex $pos_list 0] "[lindex $pos_list 0] linestart"] 02058 if {($index ne "") && [$txtt compare "[lindex $pos_list 0]-1c" != $index]} { 02059 lset pos_list 0 [$txtt index "$index+1c"] 02060 } 02061 } 02062 } 02063 02064 lset pos_list 1 [$txtt index "[lindex $pos_list 1]$adjust"] 02065 02066 return $pos_list 02067 02068 } 02069 02070 ###################################################################### 02071 # Returns a range the is split by sentences. 02072 proc get_range_sentences {txtt type num inner adjust {cursor insert}} { 02073 02074 set pos_list [list [get_index $txtt $type -dir prev -startpos "$cursor+1c"] [get_index $txtt $type -dir next -num $num]] 02075 02076 if {$inner} { 02077 set str [$txtt get {*}$pos_list] 02078 set less [expr ([string length $str] - [string length [string trimright $str]]) + 1] 02079 } else { 02080 set less 1 02081 } 02082 02083 lset pos_list 1 [$txtt index "[lindex $pos_list 1]-${less}c$adjust"] 02084 02085 return $pos_list 02086 02087 } 02088 02089 ###################################################################### 02090 # Returns the text range for a bracketed block of text. 02091 proc get_range_block {txtt type num inner adjust {cursor insert}} { 02092 02093 # Search backwards 02094 set txt [winfo parent $txtt] 02095 set number $num 02096 set startpos [expr {([lsearch [$txtt tag names $cursor] __${type}L] == -1) ? $cursor : "$cursor+1c"}] 02097 02098 while {[set index [ctext::getMatchBracket $txt ${type}L $startpos]] ne ""} { 02099 if {[incr number -1] == 0} { 02100 set right [ctext::getMatchBracket $txt ${type}R $index] 02101 if {($right eq "") || [$txtt compare $right < $cursor]} { 02102 return [list "" ""] 02103 } else { 02104 return [expr {$inner ? [list [$txt index "$index+1c"] [$txt index "$right-1c$adjust"]] : [list $index [$txt index "$right$adjust"]]}] 02105 } 02106 } else { 02107 set startpos $index 02108 } 02109 } 02110 02111 return [list "" ""] 02112 02113 } 02114 02115 ###################################################################### 02116 # Returns the text range for the given string type. 02117 proc get_range_string {txtt char tag inner adjust {cursor insert}} { 02118 02119 if {[$txtt get $cursor] eq $char} { 02120 if {[lsearch [$txtt tag names $cursor-1c] __${tag}*] == -1} { 02121 set index [gui::find_match_char [winfo parent $txtt] $char -forwards] 02122 return [expr {$inner ? [list [$txtt index "$cursor+1c"] [$txtt index "$index-1c$adjust"]] : [list [$txtt index $cursor] [$txtt index "$index$adjust"]]}] 02123 } else { 02124 set index [gui::find_match_char [winfo parent $txtt] $char -backwards] 02125 return [expr {$inner ? [list [$txtt index "$index+1c"] [$txtt index "$cursor-1c$adjust"]] : [list $index [$txtt index "$cursor$adjust"]]}] 02126 } 02127 } elseif {[set tag [lsearch -inline [$txtt tag names $cursor] __${tag}*]] ne ""} { 02128 lassign [$txtt tag prevrange $tag $cursor] startpos endpos 02129 return [expr {$inner ? [list [$txtt index "$startpos+1c"] [$txtt index "$endpos-2c$adjust"]] : [list $startpos [$txtt index "$endpos-1c$adjust"]]}] 02130 } 02131 02132 return [list "" ""] 02133 02134 } 02135 02136 ###################################################################### 02137 # Returns the startpos/endpos range based on the supplied arguments. 02138 proc get_range {txtt pos1args pos2args object move {cursor insert}} { 02139 02140 if {$object ne ""} { 02141 02142 set type [lindex $pos1args 0] 02143 set num [lindex $pos1args 1] 02144 set inner [expr {$object eq "i"}] 02145 set adjust [expr {$move ? "" : "+1c"}] 02146 02147 switch [lindex $pos1args 0] { 02148 "word" { return [get_range_word $txtt word $num $inner $adjust $cursor] } 02149 "WORD" { return [get_range_word $txtt WORD $num $inner $adjust $cursor] } 02150 "paragraph" { return [get_range_sentences $txtt paragraph $num $inner $adjust $cursor] } 02151 "sentence" { return [get_range_sentences $txtt sentence $num $inner $adjust $cursor] } 02152 "tag" { 02153 set insert [$txtt index $cursor] 02154 while {[set ranges [emmet::get_node_range [winfo parent $txtt]]] ne ""} { 02155 if {[incr num -1] == 0} { 02156 $txtt mark set insert $insert 02157 if {$inner} { 02158 return [list [lindex $ranges 1] [$txtt index "[lindex $ranges 2]-1c$adjust"]] 02159 } else { 02160 return [list [lindex $ranges 0] [$txtt index "[lindex $ranges 3]-1c$adjust"]] 02161 } 02162 } else { 02163 $txtt mark set insert "[lindex $ranges 0]-1c" 02164 } 02165 } 02166 $txtt mark set insert $insert 02167 } 02168 "paren" - 02169 "curly" - 02170 "square" - 02171 "angled" { return [get_range_block $txtt $type $num $inner $adjust $cursor] } 02172 "double" { return [get_range_string $txtt \" comstr0d $inner $adjust $cursor] } 02173 "single" { return [get_range_string $txtt \' comstr0s $inner $adjust $cursor] } 02174 "btick" { return [get_range_string $txtt \` comstr0b $inner $adjust $cursor] } 02175 } 02176 02177 } else { 02178 02179 set pos1 [$txtt index [edit::get_index $txtt {*}$pos1args -startpos $cursor]] 02180 02181 if {$pos2args ne ""} { 02182 set pos2 [$txtt index [edit::get_index $txtt {*}$pos2args -startpos $cursor]] 02183 } else { 02184 set pos2 [$txtt index $cursor] 02185 } 02186 02187 # Return the start/end position in the correct order. 02188 return [expr {[$txtt compare $pos1 < $pos2] ? [list $pos1 $pos2] : [list $pos2 $pos1]}] 02189 02190 } 02191 02192 } 02193 02194 ###################################################################### 02195 # Moves the cursor to the given position 02196 proc move_cursor {txtt position args} { 02197 02198 # Get the index to move to 02199 set index [get_index $txtt $position {*}$args] 02200 02201 # Set the insertion position and make it visible 02202 ::tk::TextSetCursor $txtt $index 02203 02204 # Adjust the insertion cursor in Vim mode 02205 vim::adjust_insert $txtt 02206 02207 } 02208 02209 ###################################################################### 02210 # Moves the cursor up/down by a single page. Valid values for dir are: 02211 # - Next 02212 # - Prior 02213 proc move_cursor_by_page {txtt dir} { 02214 02215 # Adjust the view 02216 eval [string map {%W $txtt} [bind Text <[string totitle $dir]>]] 02217 02218 # Adjust the insertion cursor in Vim mode 02219 vim::adjust_insert $txtt 02220 02221 } 02222 02223 ###################################################################### 02224 # Moves multicursors in the modifier direction for the given text widget. 02225 proc move_cursors {txtt modifier} { 02226 02227 variable columns 02228 02229 # Clear the selection 02230 $txtt tag remove sel 1.0 end 02231 02232 set columns "" 02233 02234 # Adjust the cursors 02235 multicursor::move $txtt [list $modifier -column edit::columns] 02236 02237 } 02238 02239 ###################################################################### 02240 # Applies the specified formatting to the given text widget. 02241 proc format {txtt type} { 02242 02243 # Get the range of lines to modify 02244 if {[set ranges [$txtt tag ranges sel]] eq ""} { 02245 if {[multicursor::enabled $txtt]} { 02246 foreach {start end} [$txtt tag ranges mcursor] { 02247 if {[string trim [$txtt get "$start wordstart" "$start wordend"]] ne ""} { 02248 lappend ranges [$txtt index "$start wordstart"] [$txtt index "$start wordend"] 02249 } else { 02250 lappend ranges $start $start 02251 } 02252 } 02253 } else { 02254 if {[string trim [$txtt get "insert wordstart" "insert wordend"]] ne ""} { 02255 set ranges [list [$txtt index "insert wordstart"] [$txtt index "insert wordend"]] 02256 } else { 02257 set ranges [list [$txtt index "insert"] [$txtt index "insert"]] 02258 } 02259 } 02260 } 02261 02262 if {[set ranges_len [llength $ranges]] > 0} { 02263 02264 # Get the formatting information for the current text widget 02265 array set formatting [syntax::get_formatting [winfo parent $txtt]] 02266 02267 if {[info exists formatting($type)]} { 02268 02269 lassign $formatting($type) stype pattern 02270 02271 # Figure out the string to use when asking the user for a reference 02272 switch $type { 02273 link { set refmsg [msgcat::mc "Link URL"] } 02274 image { set refmsg [msgcat::mc "Image URL"] } 02275 default { set refmsg "" } 02276 } 02277 02278 # If we need to resolve a reference do that now 02279 if {$refmsg ne ""} { 02280 set ref "" 02281 if {[gui::get_user_response $refmsg ref -allow_vars 1]} { 02282 set pattern [string map [list \{REF\} $ref] $pattern] 02283 } else { 02284 return 02285 } 02286 } 02287 02288 # Find the position of the {TEXT} substring 02289 set textpos [string first \{TEXT\} $pattern] 02290 02291 # Remove any multicursors 02292 multicursor::disable $txtt 02293 02294 $txtt edit separator 02295 02296 if {$stype eq "line"} { 02297 set last "" 02298 foreach {end start} [lreverse $ranges] { 02299 if {($last eq "") || [$txtt compare "$start linestart" != "$last linestart"]} { 02300 while {[$txtt compare $start < $end]} { 02301 set oldstr [$txtt get "$start linestart" "$start lineend"] 02302 set newstr [string map [list \{TEXT\} $oldstr] $pattern] 02303 $txtt replace "$start linestart" "$start lineend" $newstr 02304 if {$oldstr eq ""} { 02305 if {($ranges_len == 2) && [$txtt compare $start+1l >= $end]} { 02306 $txtt mark set insert "$start linestart+${textpos}c" 02307 } else { 02308 multicursor::add_cursor $txtt "$start linestart+${textpos}c" 02309 } 02310 } 02311 if {[string first \n $newstr]} { 02312 indent::format_text $txtt "$start linestart" "$start linestart+[string length $newstr]c" 0 02313 } 02314 set last $start 02315 set start [$txtt index "$start+1l"] 02316 } 02317 } 02318 } 02319 } else { 02320 foreach {end start} [lreverse $ranges] { 02321 set oldstr [$txtt get $start $end] 02322 set newstr [string map [list \{TEXT\} $oldstr] $pattern] 02323 $txtt replace $start $end $newstr 02324 if {$oldstr eq ""} { 02325 if {$ranges_len == 2} { 02326 $txtt mark set insert "$start+${textpos}c" 02327 } else { 02328 multicursor::add_cursor $txtt [$txtt index "$start+${textpos}c"] 02329 } 02330 } 02331 if {[string first \n $newstr]} { 02332 indent::format_text $txtt $start "$start+[string length $newstr]c" 0 02333 } 02334 } 02335 } 02336 02337 $txtt edit separator 02338 02339 } 02340 02341 } 02342 02343 } 02344 02345 ###################################################################### 02346 # Removes any applied text formatting found in the selection or (if no 02347 # text is currently selected the current line). 02348 proc unformat {txtt} { 02349 02350 # Get the formatting information for the current text widget 02351 array set formatting [syntax::get_formatting [winfo parent $txtt]] 02352 02353 # Get the range of lines to check 02354 if {[set ranges [$txtt tag ranges sel]] eq ""} { 02355 if {[multicursor::enabled $txtt]} { 02356 set last "" 02357 foreach {start end} [$txtt tag ranges mcursor] { 02358 if {($last eq "") || [$txtt compare "$start linestart" != "$last linestart"]} { 02359 lappend ranges [$txtt index "$start linestart"] [$txtt index "$start lineend"] 02360 set last $start 02361 } 02362 } 02363 } else { 02364 set ranges [list [$txtt index "insert linestart"] [$txtt index "insert lineend"]] 02365 } 02366 } 02367 02368 # If we have at least one range to unformat, go for it 02369 if {[llength $ranges] > 0} { 02370 02371 $txtt edit separator 02372 02373 foreach {type chars} [array get formatting] { 02374 lassign $chars stype pattern 02375 set new_ranges [list] 02376 set metalen [string length [string map {\{REF\} {} \{TEXT\} {}} $pattern]] 02377 set pattern [string map {\{REF\} {.*?} \{TEXT\} {(.*?)} \{ \\\{ \} \\\} * \\* + \\+ \\ \\\\ \( \\\( \) \\\) \[ \\\[ \] \\\] \. \\\. \? \\\? ^ \\\^ \$ \\\$} $pattern] 02378 set pattern [regsub -all {\n\s*} $pattern {\s+}] 02379 if {$stype eq "line"} { 02380 set pattern "^$pattern\$" 02381 } 02382 foreach {end start} [lreverse $ranges] { 02383 set i 0 02384 foreach index [$txtt search -all -count lengths -regexp -- $pattern $start $end] { 02385 regexp $pattern [$txtt get $index "$index+[lindex $lengths $i]c"] -> str 02386 $txtt replace $index "$index+[lindex $lengths $i]c" $str 02387 incr i 02388 } 02389 lappend new_ranges [$txtt index "$end-[expr $metalen * $i]c"] $start 02390 } 02391 set ranges [lreverse $new_ranges] 02392 set new_ranges [list] 02393 } 02394 02395 $txtt edit separator 02396 02397 } 02398 02399 } 02400 02401 }