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 }
