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: multicursor.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 5/15/2013 00022 # Brief: Namespace to handle cases where multiple cursor support is needed. 00023 ###################################################################### 00024 00025 namespace eval multicursor { 00026 00027 variable selected 0 00028 variable select_anchor "" 00029 variable cursor_anchor "" 00030 00031 array set copy_cursors {} 00032 00033 ###################################################################### 00034 # Adds bindings for multicursor support to the supplied text widget. 00035 proc add_bindings {txt} { 00036 00037 # Create tag for the multicursor stuff 00038 $txt tag configure mcursor -underline 1 00039 $txt tag place mcursor visible1 00040 00041 # Create multicursor bindings 00042 bind mcursor$txt <<Selection>> [list multicursor::handle_selection %W] 00043 bind mcursor$txt <Mod2-Button-1> [list multicursor::handle_alt_button1 %W %x %y] 00044 bind mcursor$txt <Mod2-Button-$::right_click> [list multicursor::handle_alt_button3 %W %x %y] 00045 bind mcursor$txt <Key-Delete> "if {\[multicursor::handle_delete %W\]} { break }" 00046 bind mcursor$txt <Key-BackSpace> "if {\[multicursor::handle_backspace %W\]} { break }" 00047 bind mcursor$txt <Return> "if {\[multicursor::handle_return %W\]} { break }" 00048 bind mcursor$txt <Any-KeyPress> "if {\[multicursor::handle_keypress %W %A %K\]} { break }" 00049 bind mcursor$txt <Escape> [list multicursor::handle_escape %W] 00050 bind mcursor$txt <Button-1> [list multicursor::disable %W] 00051 00052 # Add the multicursor bindings to the text widget's bindtags 00053 set all_index [lsearch -exact [bindtags $txt.t] all] 00054 bindtags $txt.t [linsert [bindtags $txt.t] [expr $all_index + 1] mcursor$txt] 00055 00056 } 00057 00058 ###################################################################### 00059 # Called when the specified text widget is destroyed. 00060 proc handle_destroy_txt {txt} { 00061 00062 variable copy_cursors 00063 00064 array unset copy_cursors $txt.t,* 00065 00066 } 00067 00068 ###################################################################### 00069 # Handles a selection of the widget in the multicursor mode. 00070 proc handle_selection {W} { 00071 00072 variable selected 00073 00074 # If we are in multimove Vim mode, return immediately 00075 if {[vim::in_multimove $W]} { 00076 return 00077 } 00078 00079 set selected 0 00080 00081 if {[llength [set sel [$W tag ranges sel]]] > 2} { 00082 set selected 1 00083 $W tag remove mcursor 1.0 end 00084 foreach {start end} $sel { 00085 $W tag add mcursor $start 00086 } 00087 } 00088 00089 } 00090 00091 ###################################################################### 00092 # Handles an Alt-Button-1 event when in multicursor mode. 00093 proc handle_alt_button1 {W x y} { 00094 00095 add_cursor $W [$W index @$x,$y] 00096 00097 } 00098 00099 ###################################################################### 00100 # Handles an Alt-Button-3 event when in multicursor mode. 00101 proc handle_alt_button3 {W x y} { 00102 00103 add_cursors $W [$W index @$x,$y] 00104 00105 } 00106 00107 ###################################################################### 00108 # Handles a delete key event in multicursor mode. 00109 proc handle_delete {W} { 00110 00111 if {![vim::in_vim_mode $W] && [multicursor::delete $W [list char -dir next] ""]} { 00112 return 1 00113 } 00114 00115 return 0 00116 00117 } 00118 00119 ###################################################################### 00120 # Handles a backspace key event in multicursor mode. 00121 proc handle_backspace {W} { 00122 00123 if {![vim::in_vim_mode $W] && [multicursor::delete $W [list char -dir prev] ""]} { 00124 return 1 00125 } 00126 00127 return 0 00128 00129 } 00130 00131 ###################################################################### 00132 # Handles a return key event in multicursor mode. 00133 proc handle_return {W} { 00134 00135 if {![vim::in_vim_mode $W] && [multicursor::insert $W "\n" indent::newline]} { 00136 return 1 00137 } 00138 00139 return 0 00140 00141 } 00142 00143 ###################################################################### 00144 # Handles a keypress event in multicursor mode. 00145 proc handle_keypress {W A K} { 00146 00147 if {([string compare -length 5 $K "Shift"] != 0) && \ 00148 ([string compare -length 7 $K "Control"] != 0) && \ 00149 ([string compare -length 3 $K "Alt"] != 0) && \ 00150 ($K ne "??") && \ 00151 ![vim::in_vim_mode $W]} { 00152 if {[string length $A] == 0} { 00153 multicursor::disable $W 00154 } elseif {[string is print $A] && [multicursor::insert $W $A indent::check_indent]} { 00155 return 1 00156 } 00157 } 00158 00159 return 0 00160 00161 } 00162 00163 ###################################################################### 00164 # Handles an escape event in multicursor mode. 00165 proc handle_escape {W} { 00166 00167 if {[set first [lindex [$W tag ranges mcursor] 0]] ne ""} { 00168 00169 # If we are not in a multimove, delete the mcursors 00170 if {![vim::in_multimove $W] && ([vim::get_edit_mode $W] eq "")} { 00171 disable $W 00172 00173 # Otherwise, position the insertion cursor on the first multicursor position 00174 } else { 00175 ::tk::TextSetCursor $W $first 00176 } 00177 00178 } 00179 00180 } 00181 00182 ###################################################################### 00183 # Returns 1 if multiple selections exist; otherwise, returns 0. 00184 proc enabled {txtt} { 00185 00186 return [expr [llength [$txtt tag ranges mcursor]] > 0] 00187 00188 } 00189 00190 ###################################################################### 00191 # Disables the multicursor mode for the given text widget. 00192 proc disable {txtt} { 00193 00194 variable cursor_anchor 00195 00196 # Clear the start positions value 00197 $txtt tag remove mcursor 1.0 end 00198 00199 # Clear the current anchor 00200 set cursor_anchor "" 00201 00202 } 00203 00204 ###################################################################### 00205 # Set a multicursor at the given index. 00206 proc add_cursor {txtt index} { 00207 00208 variable cursor_anchor 00209 00210 if {[$txtt compare "$index lineend" == $index]} { 00211 $txtt insert $index " " 00212 } 00213 00214 if {[llength [set mcursors [lsearch -inline [$txtt tag names $index] mcursor*]]] == 0} { 00215 $txtt tag add mcursor $index 00216 } else { 00217 $txtt tag remove mcursor $index 00218 } 00219 00220 # Set the cursor anchor to the current index 00221 set cursor_anchor $index 00222 00223 } 00224 00225 ###################################################################### 00226 # Set multicursors between the anchor and the current line. 00227 proc add_cursors {txtt index} { 00228 00229 variable cursor_anchor 00230 00231 if {$cursor_anchor ne ""} { 00232 00233 # Get the anchor line and column 00234 lassign [split [set orig_anchor $cursor_anchor] .] row col 00235 00236 # Get the current row 00237 set curr_row [lindex [split $index .] 0] 00238 00239 # Set the cursor 00240 if {$row < $curr_row} { 00241 for {set i [expr $row + 1]} {$i <= $curr_row} {incr i} { 00242 add_cursor $txtt $i.$col 00243 } 00244 } else { 00245 for {set i $curr_row} {$i < $row} {incr i} { 00246 add_cursor $txtt $i.$col 00247 } 00248 } 00249 00250 # Re-set the cursor anchor 00251 set cursor_anchor $orig_anchor 00252 00253 } 00254 00255 } 00256 00257 ###################################################################### 00258 # Searches for any string matches in the from/to range that match the 00259 # regular expression "exp". Whenever a match is found, the first 00260 # character in the match is added to the current cursor list. 00261 proc search_and_add_cursors {txt from to exp} { 00262 00263 foreach index [$txt search -regexp -all $exp $from $to] { 00264 add_cursor $txt $index 00265 } 00266 00267 } 00268 00269 ###################################################################### 00270 # Adjusts the view to make sure that previously viewable cursors are 00271 # still visible. 00272 proc adjust_set_and_view {txtt prev next} { 00273 00274 # Add the multicursor 00275 $txtt tag add mcursor $next 00276 00277 # If our next cursor is going off screen, make it viewable 00278 if {([$txtt bbox $prev] ne "") && ([$txtt bbox $next] eq "")} { 00279 $txtt see $next 00280 } 00281 00282 } 00283 00284 ###################################################################### 00285 # Adjusts the selection if we are in a Vim visual mode. 00286 proc adjust_select {txtt} { 00287 00288 if {[vim::in_visual_mode $txtt]} { 00289 $txtt tag remove sel 1.0 end 00290 set i 0 00291 foreach {start end} [$txtt tag ranges mcursor] { 00292 vim::adjust_select $txtt $i $start 00293 incr i 00294 } 00295 } 00296 00297 } 00298 00299 ###################################################################### 00300 # Returns true if the given motion is not supported by multicursor mode. 00301 proc motion_unsupported {txtt motion} { 00302 00303 return [expr [lsearch [list linenum screentop screenmid screenbot first last] $motion] != -1] 00304 00305 } 00306 00307 ###################################################################### 00308 # Moves all of the cursors using the positional arguments. 00309 proc move {txtt posargs} { 00310 00311 array set opts { 00312 -num 1 00313 } 00314 array set opts [lassign $posargs motion] 00315 00316 # If the motion is not supported, return now 00317 if {[motion_unsupported $txtt $motion]} { 00318 return 00319 } 00320 00321 # Get the existing ranges 00322 set ranges [$txtt tag ranges mcursor] 00323 00324 # Get the list of new ranges 00325 set new_ranges [list] 00326 foreach {start end} $ranges { 00327 set new_start [$txtt index [edit::get_index $txtt {*}$posargs -startpos $start]] 00328 if {[$txtt compare $new_start == "$new_start lineend"] && [$txtt compare $new_start > "$new_start linestart"]} { 00329 set new_start [$txtt index $new_start-1c] 00330 } 00331 lappend new_ranges $start $new_start 00332 } 00333 00334 # If any cursors are going to "fall off" an edge, don't perform the move 00335 switch $motion { 00336 left { 00337 foreach {start new_start} $new_ranges { 00338 if {([lindex [split $start .] 1] - [lindex [split $new_start .] 1]) < $opts(-num)} { 00339 adjust_select $txtt 00340 return 00341 } 00342 } 00343 } 00344 right { 00345 foreach {start new_start} $new_ranges { 00346 if {([lindex [split $new_start .] 1] - [lindex [split $start .] 1]) < $opts(-num)} { 00347 adjust_select $txtt 00348 return 00349 } 00350 } 00351 } 00352 up { 00353 if {([lindex [split [lindex $new_ranges 0] .] 0] - [lindex [split [lindex $new_ranges 1] .] 0]) < $opts(-num)} { 00354 adjust_select $txtt 00355 return 00356 } 00357 } 00358 down { 00359 if {([lindex [split [lindex $new_ranges end] .] 0] - [lindex [split [lindex $new_ranges end-1] .] 0]) < $opts(-num)} { 00360 adjust_select $txtt 00361 return 00362 } 00363 } 00364 } 00365 00366 # Move the cursors 00367 $txtt tag remove mcursor 1.0 end 00368 foreach {new_start start} [lreverse $new_ranges] { 00369 if {[$txtt compare "$new_start linestart" == "$new_start lineend"]} { 00370 $txtt fastinsert -update 0 -undo 0 "$new_start lineend" " " dspace 00371 } 00372 adjust_set_and_view $txtt $start $new_start 00373 } 00374 00375 # Adjust the selection 00376 adjust_select $txtt 00377 00378 } 00379 00380 ###################################################################### 00381 # Handles multicursor deletion using the esposargs and sposargs parameters 00382 # for calculating the deletion ranges. 00383 proc delete {txtt eposargs {sposargs ""} {object ""}} { 00384 00385 variable selected 00386 00387 set start 1.0 00388 set ranges [list] 00389 set do_tags [list] 00390 set txt [winfo parent $txtt] 00391 set dat "" 00392 00393 # Only perform this if multiple cursors 00394 if {[enabled $txtt]} { 00395 00396 # If the motion is not supported, return now 00397 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00398 return 1 00399 } 00400 00401 if {$selected || ($eposargs eq "selected")} { 00402 set range [$txt tag nextrange sel $start] 00403 while {$range ne [list]} { 00404 lassign $range start end 00405 append dat [$txt get $start $end] 00406 ctext::comments_chars_deleted $txt $start $end do_tags 00407 $txt tag remove mcursor [lindex $range 0] 00408 $txt fastdelete -update 0 $start $end 00409 lappend ranges [$txt index "$start linestart"] [$txt index "$start lineend"] 00410 set range [$txt tag nextrange sel $start] 00411 if {([$txtt compare $start == "$start linestart"]) || ([$txtt compare $start != "$start lineend"])} { 00412 add_cursor $txtt $start 00413 } else { 00414 add_cursor $txtt "$start-1c" 00415 } 00416 } 00417 set selected 0 00418 00419 } else { 00420 set range [$txt tag nextrange mcursor $start] 00421 while {$range ne [list]} { 00422 lassign [edit::get_range $txt $eposargs $sposargs $object 0 [lindex $range 0]] start end 00423 if {([set next [lindex [$txt tag nextrange mcursor [lindex $range 1]] 0]] ne "") && [$txt compare $end > $next]} { 00424 set end $next 00425 } 00426 append dat [$txt get $start $end] 00427 ctext::comments_chars_deleted $txt $start $end do_tags 00428 $txt tag remove mcursor [lindex $range 0] 00429 $txt fastdelete -update 0 $start $end 00430 lappend ranges [$txt index "$start linestart"] [$txt index "$start lineend"] 00431 set range [$txt tag nextrange mcursor $start] 00432 if {([$txtt compare $start == "$start linestart"]) || ([$txtt compare $start != "$start lineend"])} { 00433 add_cursor $txtt $start 00434 } else { 00435 add_cursor $txtt "$start-1c" 00436 } 00437 } 00438 00439 } 00440 00441 # Highlight and audit brackets 00442 if {[ctext::highlightAll $txt $ranges 0 $do_tags]} { 00443 ctext::checkAllBrackets $txt 00444 } else { 00445 ctext::checkAllBrackets $txt $dat 00446 } 00447 ctext::modified $txt 1 [list delete $ranges ""] 00448 00449 event generate $txt.t <<CursorChanged>> 00450 00451 return 1 00452 00453 } 00454 00455 return 0 00456 00457 } 00458 00459 ###################################################################### 00460 # Handles the insertion of a printable character. 00461 proc insert {txtt value {indent_cmd ""}} { 00462 00463 variable selected 00464 00465 # Insert the value into the text widget for each of the starting positions 00466 if {[enabled $txtt]} { 00467 00468 set do_tags [list] 00469 set txt [winfo parent $txtt] 00470 if {$selected} { 00471 foreach {end start} [lreverse [$txtt tag ranges mcursor]] { 00472 ctext::comments_chars_deleted $txt $start $end do_tags 00473 $txtt fastdelete $start $end 00474 $txtt tag add mcursor $start 00475 } 00476 set selected 0 00477 } 00478 set start 1.0 00479 set ranges [list] 00480 set valuelen [string length $value] 00481 while {[set range [$txtt tag nextrange mcursor $start]] ne [list]} { 00482 set start [lindex $range 0] 00483 $txtt fastinsert -update 0 $start $value 00484 ctext::comments_do_tag $txt $start "$start+${valuelen}c" do_tags 00485 lappend ranges "$start linestart" "$start+${valuelen}c lineend" 00486 set start "$start+[expr $valuelen + 1]c" 00487 } 00488 if {[ctext::highlightAll $txt $ranges 1 $do_tags]} { 00489 ctext::checkAllBrackets $txt 00490 } else { 00491 ctext::checkAllBrackets $txt $value 00492 } 00493 ctext::modified $txt 1 [list insert $ranges ""] 00494 if {$indent_cmd ne ""} { 00495 set start 1.0 00496 while {[set range [$txtt tag nextrange mcursor $start]] ne [list]} { 00497 set start [$indent_cmd $txtt [lindex $range 0] 0]+2c 00498 } 00499 } else { 00500 event generate $txtt <<CursorChanged>> 00501 } 00502 00503 return 1 00504 00505 } 00506 00507 return 0 00508 00509 } 00510 00511 ###################################################################### 00512 # Handle the replacement of a given character. 00513 proc replace {txtt value {indent_cmd ""}} { 00514 00515 variable selected 00516 00517 set txt [winfo parent $txtt] 00518 00519 # Replace the current insertion cursor with the given value 00520 if {[enabled $txt]} { 00521 if {$selected} { 00522 return [insert $txt $value $indent_cmd] 00523 } else { 00524 set start 1.0 00525 set do_tags [list] 00526 set valuelen [string length $value] 00527 set dat $value 00528 while {[set range [$txt tag nextrange mcursor $start]] ne [list]} { 00529 lassign $range start end 00530 append dat [$txt get $start $end] 00531 ctext::comments_chars_deleted $txt $start $end do_tags 00532 $txt fastreplace -update 0 $start "$start+1c" $value 00533 ctext::comments_do_tag $txt $start "$start+${valuelen}c" do_tags 00534 $txt tag add mcursor "$start+${valuelen}c" 00535 set start "$start+[expr $valuelen + 1]c" 00536 lappend ranges {*}$range 00537 } 00538 if {[ctext::highlightAll $txt $ranges 1 $do_tags]} { 00539 ctext::checkAllBrackets $txt 00540 } else { 00541 ctext::checkAllBrackets $txt $dat 00542 } 00543 ctext::modified $txt 1 [list replace $ranges ""] 00544 if {$indent_cmd ne ""} { 00545 set start 1.0 00546 while {[set range [$txt tag nextrange mcursor $start]] ne [list]} { 00547 set start [$indent_cmd $txtt [lindex $range 0] 0]+2c 00548 } 00549 } else { 00550 event generate $txt.t <<CursorChanged>> 00551 } 00552 return 1 00553 } 00554 } 00555 00556 return 0 00557 00558 } 00559 00560 ###################################################################### 00561 # Toggles the case of all characters that match the given positional arguments. 00562 proc toggle_case {txtt eposargs sposargs object} { 00563 00564 if {[enabled [winfo parent $txtt]]} { 00565 00566 # If the motion is not supported, return now 00567 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00568 return 1 00569 } 00570 00571 foreach {start end} [$txtt tag ranges mcursor] { 00572 edit::convert_case_toggle $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00573 $txtt tag add mcursor $start 00574 } 00575 00576 return 1 00577 00578 } 00579 00580 return 0 00581 00582 } 00583 00584 ###################################################################### 00585 # Transforms all text to upper case for the given multicursor ranges. 00586 proc upper_case {txtt eposargs sposargs object} { 00587 00588 if {[enabled [winfo parent $txtt]]} { 00589 00590 # If the motion is not supported, return now 00591 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00592 return 1 00593 } 00594 00595 foreach {start end} [$txtt tag ranges mcursor] { 00596 edit::convert_to_upper_case $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00597 $txtt tag add mcursor $start 00598 } 00599 00600 return 1 00601 00602 } 00603 00604 return 0 00605 00606 } 00607 00608 ###################################################################### 00609 # Transforms all text to lower case for the given multicursor ranges. 00610 proc lower_case {txtt eposargs sposargs object} { 00611 00612 if {[enabled [winfo parent $txtt]]} { 00613 00614 # If the motion is not supported, return now 00615 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00616 return 1 00617 } 00618 00619 foreach {start end} [$txtt tag ranges mcursor] { 00620 edit::convert_to_lower_case $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00621 $txtt tag add mcursor $start 00622 } 00623 00624 return 1 00625 00626 } 00627 00628 return 0 00629 00630 } 00631 00632 ###################################################################### 00633 # Transforms all text to rot13 for the given multicursor ranges. 00634 proc rot13 {txtt eposargs sposargs object} { 00635 00636 if {[enabled [winfo parent $txtt]]} { 00637 00638 # If the motion is not supported, return now 00639 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00640 return 1 00641 } 00642 00643 foreach {start end} [$txtt tag ranges mcursor] { 00644 edit::convert_to_rot13 $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00645 $txtt tag add mcursor $start 00646 } 00647 00648 return 1 00649 00650 } 00651 00652 return 0 00653 00654 } 00655 00656 ###################################################################### 00657 # Perform text indentation formatting for each multicursor line. 00658 proc format_text {txtt eposargs sposargs object} { 00659 00660 if {[enabled [winfo parent $txtt]]} { 00661 00662 # If the motion is not supported, return now 00663 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00664 return 1 00665 } 00666 00667 foreach {start end} [$txtt tag ranges mcursor] { 00668 indent::format_text $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00669 $txtt tag add mcursor $start 00670 } 00671 00672 return 1 00673 00674 } 00675 00676 return 0 00677 00678 } 00679 00680 ###################################################################### 00681 # Perform a left or right indentation shift for each multicursor line. 00682 proc shift {txtt dir eposargs sposargs object } { 00683 00684 if {[enabled [winfo parent $txtt]]} { 00685 00686 # If the motion is not supported, return now 00687 if {[motion_unsupported $txtt [lindex $eposargs 0]]} { 00688 return 1 00689 } 00690 00691 if {$dir eq "right"} { 00692 foreach {start end} [$txtt tag ranges mcursor] { 00693 edit::indent $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00694 } 00695 } else { 00696 foreach {start end} [$txtt tag ranges mcursor] { 00697 edit::unindent $txtt {*}[edit::get_range $txtt $eposargs $sposargs $object 0 $start] 00698 } 00699 } 00700 00701 return 1 00702 00703 } 00704 00705 return 0 00706 00707 } 00708 00709 ###################################################################### 00710 # Parses the given number string with the format of: 00711 # (d|o|x)?<number>+ 00712 # Where d means to parse and insert decimal numbers, o means to parse 00713 # and insert octal numbers, and x means to parse and insert hexidecimal 00714 # numbers. If d, o or x are not specified, d is assumed. 00715 # Numbers will be inserted at each cursor location such that the first 00716 # cursor will be replaced with the number specified by <number>+ and 00717 # each successive cursor will have an incrementing value inserted 00718 # at its location. 00719 proc insert_numbers {txt numstr} { 00720 00721 variable selected 00722 00723 # If the number string is a decimal number without a preceding 'd' character, add it now 00724 if {[set d_added [regexp {^[0-9]+([+-]\d*)?$} $numstr]]} { 00725 set numstr "d$numstr" 00726 } 00727 00728 # Parse the number string to verify that it's valid 00729 if {[regexp -nocase {^(.*)(b[0-1]*|d[0-9]*|o[0-7]*|[xh][0-9a-fA-F]*)([+-]\d*)?$} $numstr -> prefix numstr increment]} { 00730 00731 # Get the cursors 00732 set mcursors [lreverse [$txt tag ranges mcursor]] 00733 00734 # Get the last number 00735 set num_mcursors [expr ([llength $mcursors] / 2)] 00736 00737 # If things were selected, delete their characters and re-add the multicursors 00738 if {$selected} { 00739 foreach {end start} $mcursors { 00740 $txt delete $start $end 00741 $txt tag add mcursor $start 00742 } 00743 set selected 0 00744 } 00745 00746 # Get the number portion of the number string. If one does not exist, 00747 # default the number to 0. 00748 if {[set num [string range $numstr 1 end]] eq ""} { 00749 set num 0 00750 } 00751 00752 # Initialize the value of increment if it was not specified by the user explicitly 00753 if {$increment eq ""} { 00754 set increment "+1" 00755 } elseif {$increment eq "+"} { 00756 set increment "+1" 00757 } elseif {$increment eq "-"} { 00758 set increment "-1" 00759 } 00760 00761 # Calculate the num and increment values 00762 if {[string index $increment 0] eq "+"} { 00763 set increment [string range $increment 1 end] 00764 set num [expr $num + (($num_mcursors - 1) * $increment)] 00765 set increment "-$increment" 00766 } else { 00767 set increment [string range $increment 1 end] 00768 set num [expr $num - (($num_mcursors - 1) * $increment)] 00769 set increment "+$increment" 00770 } 00771 00772 # Handle the value insertions 00773 switch [string tolower [string index $numstr 0]] { 00774 b { 00775 foreach {end start} $mcursors { 00776 set binRep [binary format c $num] 00777 binary scan $binRep B* binStr 00778 $txt insert $start [format "%s%s%s" $prefix [string trimleft [string range $binStr 0 end-1] 0] [string index $binStr end]] 00779 incr num $increment 00780 } 00781 } 00782 d { 00783 foreach {end start} $mcursors { 00784 $txt insert $start [format "%s%d" $prefix $num] 00785 incr num $increment 00786 } 00787 } 00788 o { 00789 foreach {end start} $mcursors { 00790 $txt insert $start [format "%s%o" $prefix $num] 00791 incr num $increment 00792 } 00793 } 00794 h - 00795 x { 00796 foreach {end start} $mcursors { 00797 $txt insert $start [format "%s%x" $prefix $num] 00798 incr num $increment 00799 } 00800 } 00801 } 00802 00803 return 1 00804 00805 } 00806 00807 return 0 00808 00809 } 00810 00811 ###################################################################### 00812 # Aligns all multicursors to each other, aligning them to the cursor 00813 # that is closest to the start of its line. 00814 proc align {txt} { 00815 00816 set last_row -1 00817 set min_col 1000000 00818 set rows [list] 00819 00820 # Find the cursor that is closest to the start of its line 00821 foreach {start end} [$txt tag ranges mcursor] { 00822 lassign [split $start .] row col 00823 if {$row ne $last_row} { 00824 set last_row $row 00825 if {$col < $min_col} { 00826 set min_col $col 00827 } 00828 lappend rows $row 00829 } 00830 } 00831 00832 if {[llength $rows] > 0} { 00833 00834 # Create the cursors list 00835 foreach row $rows { 00836 lappend cursors $row.$min_col $row.[expr $min_col + 1] 00837 } 00838 00839 # Remove the multicursors 00840 $txt tag remove mcursor 1.0 end 00841 00842 # Add the cursors back 00843 $txt tag add mcursor {*}$cursors 00844 00845 } 00846 00847 } 00848 00849 ###################################################################### 00850 # Aligns all of the cursors by inserting spaces prior to each cursor 00851 # that is less than the one in the highest column position. If multiple 00852 # cursors exist on the same line, the cursor in the lowest column position 00853 # is used. 00854 proc align_with_text {txt} { 00855 00856 set last_row -1 00857 set max_col 0 00858 set cursors [list] 00859 00860 # Find the cursor position to align to and the cursors to align 00861 foreach {start end} [$txt tag ranges mcursor] { 00862 lassign [split $start .] row col 00863 if {$row ne $last_row} { 00864 set last_row $row 00865 if {$col > $max_col} { 00866 set max_col $col 00867 } 00868 lappend cursors [list $row $col] 00869 } 00870 } 00871 00872 # Insert spaces to align all columns 00873 foreach cursor $cursors { 00874 $txt insert [join $cursor .] [string repeat " " [expr $max_col - [lindex $cursor 1]]] 00875 } 00876 00877 } 00878 00879 ###################################################################### 00880 # Copies any multicursors found in the given text block. 00881 proc copy {txt start end} { 00882 00883 variable copy_cursors 00884 00885 # Current index 00886 set current $start 00887 00888 # Initialize copy cursor information 00889 set copy_cursors($txt,offsets) [list] 00890 set copy_cursors($txt,value) [clipboard get] 00891 00892 # Get the mcursor offsets from start 00893 while {[set index [$txt tag nextrange mcursor $current $end]] ne ""} { 00894 lappend copy_cursors($txt,offsets) [$txt count -chars $start [lindex $index 0]] 00895 set current [$txt index "[lindex $index 0]+1c"] 00896 } 00897 00898 } 00899 00900 ###################################################################### 00901 # Adds multicursors to the given pasted text. 00902 proc paste {txt start} { 00903 00904 variable copy_cursors 00905 00906 # Only perform the operation if the stored value matches the clipboard contents 00907 if {[info exists copy_cursors($txt,value)] && ($copy_cursors($txt,value) eq [clipboard get])} { 00908 00909 # Add the mcursors 00910 foreach offset $copy_cursors($txt,offsets) { 00911 $txt tag add mcursor "$start+${offset}c" 00912 } 00913 00914 } 00915 00916 } 00917 00918 }