00001 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00002 #
00003 # This program is free software; you can redistribute it and/or modify
00004 # it under the terms of the GNU General Public License as published by
00005 # the Free Software Foundation; either version 2 of the License, or
00006 # (at your option) any later version.
00007 #
00008 # This program is distributed in the hope that it will be useful,
00009 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00010 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00011 # GNU General Public License for more details.
00012 #
00013 # You should have received a copy of the GNU General Public License along
00014 # with this program; if not, write to the Free Software Foundation, Inc.,
00015 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00016
00017 ######################################################################
00018 # Name: select.tcl
00019 # Author: Trevor Williams (trevorw@sgi.com)
00020 # Date: 06/05/2017
00021 # Brief: Provides select mode functionality.
00022 ######################################################################
00023
00024 # msgcat::note Go to Edit menu, select "Select Mode" and hit the '?' key to view strings.
00025
00026 namespace eval select {
00027
00028 array set motions {}
00029 array set data {}
00030 array set positions {
00031 char {dchar dchar}
00032 block {dchar dchar}
00033 line {linestart lineend}
00034 lineto {linestart lineend}
00035 word {wordstart {wordend -forceadjust "+1 display chars"}}
00036 sentence {sentence sentence}
00037 paragraph {paragraph paragraph}
00038 node {tagstart {tagend -forceadjust "+1 display chars"}}
00039 square {{char -char \[} {char -char \]}}
00040 curly {{char -char \{} {char -char \}}}
00041 paren {{char -char \(} {char -char \)}}
00042 angled {{char -char <} {char -char >}}
00043 double {{char -char \"} {char -char \"}}
00044 single {{char -char \'} {char -char \'}}
00045 btick {{char -char \`} {char -char \`}}
00046 }
00047 variable types [list \
00048 [list [msgcat::mc "Character"] c char] \
00049 [list [msgcat::mc "Word"] w word] \
00050 [list [msgcat::mc "Line"] e line] \
00051 [list [msgcat::mc "Line To"] E lineto] \
00052 [list [msgcat::mc "Sentence"] s sentence] \
00053 [list [msgcat::mc "Paragraph"] p paragraph] \
00054 [list [msgcat::mc "Node"] n node] \
00055 [list [msgcat::mc "Square Brackets"] \[ square] \
00056 [list [msgcat::mc "Parenthesis"] \( paren] \
00057 [list [msgcat::mc "Curly Brackets"] \{ curly] \
00058 [list [msgcat::mc "Angled Brackets"] < angled] \
00059 [list [msgcat::mc "Comment"] # comment] \
00060 [list [msgcat::mc "Double Quotes"] \" double] \
00061 [list [msgcat::mc "Single Quotes"] \' single] \
00062 [list [msgcat::mc "Backticks"] \` btick] \
00063 [list [msgcat::mc "Block"] b block] \
00064 [list [msgcat::mc "All"] * all] \
00065 [list [msgcat::mc "All To"] . allto] \
00066 ]
00067
00068 ######################################################################
00069 # Adds bindings for selection mode. Returns the hierarchical reference
00070 # to the select mode bar widget which needs to be packed into a grid
00071 # controlled layout manager and hidden from view.
00072 proc add {txt frame} {
00073
00074 variable data
00075
00076 set data($txt.t,mode) 0
00077 set data($txt.t,type) none
00078 set data($txt.t,anchor) 1.0
00079 set data($txt.t,anchorend) 0
00080 set data($txt.t,dont_close) 0
00081 set data($txt.t,inner) 1
00082 set data($txt.t,number) ""
00083 set data($txt.t,undo) [list]
00084
00085 set alt [expr {([tk windowingsystem] eq "aqua") ? "Mod2" : "Alt"}]
00086
00087 bind select <<Selection>> [list select::handle_selection %W]
00088 bind select <FocusOut> [list select::handle_focusout %W]
00089 bind select <Key> "if {\[select::handle_any %W %K\]} break"
00090 bind select <Return> "if {\[select::handle_return %W\]} break"
00091 bind select <Escape> "if {\[select::handle_escape %W\]} break"
00092 bind select <BackSpace> "if {\[select::handle_backspace %W\]} break"
00093 bind select <Delete> "if {\[select::handle_delete %W\]} break"
00094 bind select <Double-Button-1> "if {\[select::handle_double_click %W %x %y\]} break"
00095 bind select <Triple-Button-1> "if {\[select::handle_triple_click %W %x %y\]} break"
00096 bind select <$alt-ButtonPress-1> "if {\[select::handle_single_press %W %x %y\]} break"
00097 bind select <$alt-ButtonRelease-1> "if {\[select::handle_single_release %W %x %y\]} break"
00098 bind select <$alt-B1-Motion> "if {\[select::handle_alt_motion %W %x %y\]} break"
00099 bind select <Control-Double-Button-1> "if {\[select::handle_control_double_click %W %x %y\]} break"
00100 bind select <Control-Triple-Button-1> "if {\[select::handle_control_triple_click %W %x %y\]} break"
00101 bind select <Shift-Control-Double-Button-1> "if {\[select::handle_shift_control_double_click %W %x %y\]} break"
00102 bind select <Shift-Control-Triple-Button-1> "if {\[select::handle_shift_control_triple_click %W %x %y\]} break"
00103
00104 bindtags $txt.t [linsert [bindtags $txt.t] [expr [lsearch [bindtags $txt.t] $txt.t] + 1] select]
00105
00106 }
00107
00108 ######################################################################
00109 # Performs an undo of the selection buffer.
00110 proc undo {txtt} {
00111
00112 variable data
00113
00114 if {[llength $data($txtt,undo)] > 1} {
00115
00116 lassign [lindex $data($txtt,undo) end-1] type anchorend ranges
00117
00118 # Set variables
00119 set data($txtt,undo) [lrange $data($txtt,undo) 0 end-1]
00120 set data($txtt,dont_close) 1
00121 set data($txtt,type) $type
00122 set data($txtt,anchorend) $anchorend
00123
00124 # Calculate the insertion cursor index in the ranges list
00125 set index [expr {$anchorend ? 0 : "end"}]
00126
00127 # Clear the current selection and set the cursor
00128 ::tk::TextSetCursor $txtt [lindex $ranges $index]
00129
00130 # Add the selection
00131 $txtt tag add sel {*}$ranges
00132
00133 }
00134
00135 }
00136
00137 ######################################################################
00138 # Creates the selection mode bar which displays the currently selected
00139 # modes, their key bindings and their description.
00140 proc show_help {txtt} {
00141
00142 variable types
00143 variable data
00144
00145 if {[winfo exists .selhelp]} {
00146 return
00147 }
00148
00149 # Create labels and their shortcuts
00150 set left [list [msgcat::mc "Left"] "h"]
00151 set right [list [msgcat::mc "Right"] "l"]
00152 set up [list [msgcat::mc "Up"] "k"]
00153 set down [list [msgcat::mc "Down"] "j"]
00154 set lshift [list [msgcat::mc "Shift Left"] "H"]
00155 set rshift [list [msgcat::mc "Shift Right"] "L"]
00156 set ushift [list [msgcat::mc "Shift Up"] "K"]
00157 set dshift [list [msgcat::mc "Shift Down"] "J"]
00158 set next [list [msgcat::mc "Next"] "l"]
00159 set prev [list [msgcat::mc "Previous"] "h"]
00160 set parent [list [msgcat::mc "Parent"] "h"]
00161 set child [list [msgcat::mc "Child"] "l"]
00162 set nsib [list [msgcat::mc "Next Sibling"] "j"]
00163 set psib [list [msgcat::mc "Previous Sibling"] "k"]
00164 set swap [list [msgcat::mc "Swap Anchor"] "a"]
00165 set undo [list [msgcat::mc "Undo Last Change"] "u"]
00166 set help [list [msgcat::mc "Toggle Help"] "?"]
00167 set ret [list [msgcat::mc "Keep Selection"] "\u21b5"]
00168 set esc [list [msgcat::mc "Clear Selection"] "Esc"]
00169 set del [list [msgcat::mc "Delete Selected Text"] "Del"]
00170 set inv [list [msgcat::mc "Invert Selected Text"] "~"]
00171 set find [list [msgcat::mc "Add Selection Matches"] "/"]
00172 set inc [list [msgcat::mc "Toggle Quote Inclusion"] "i"]
00173
00174 toplevel .selhelp
00175 wm transient .selhelp .
00176 wm overrideredirect .selhelp 1
00177
00178 ttk::label .selhelp.title -text [msgcat::mc "Selection Mode Command Help"] -anchor center -padding 4
00179 ttk::label .selhelp.close -image form_close -padding {8 0}
00180 ttk::separator .selhelp.sep -orient horizontal
00181 ttk::frame .selhelp.f
00182
00183 bind .selhelp.close <Button-1> [list select::hide_help]
00184
00185 ttk::labelframe .selhelp.f.types -text [msgcat::mc "Modes"]
00186 create_list .selhelp.f.types $types $txtt
00187
00188 ttk::labelframe .selhelp.f.motions -text [msgcat::mc "Motions"]
00189 switch $data($txtt,type) {
00190 char -
00191 block {
00192 create_list .selhelp.f.motions [list $left $right $up $down $lshift $rshift $ushift $dshift]
00193 }
00194 word -
00195 sentence -
00196 paragraph {
00197 create_list .selhelp.f.motions [list $next $prev $lshift $rshift]
00198 }
00199 line -
00200 lineto {
00201 create_list .selhelp.f.motions [list $down $up $dshift $ushift]
00202 }
00203 node -
00204 curly -
00205 square -
00206 paren -
00207 angled {
00208 create_list .selhelp.f.motions [list $parent $child $nsib $psib $dshift $ushift]
00209 }
00210 all -
00211 allto -
00212 default {
00213 create_list .selhelp.f.motions [list $inc]
00214 }
00215 }
00216
00217 ttk::labelframe .selhelp.f.anchors -text [msgcat::mc "Anchor"]
00218 create_list .selhelp.f.anchors [list $swap]
00219
00220 ttk::labelframe .selhelp.f.help -text [msgcat::mc "Miscellaneous"]
00221 create_list .selhelp.f.help [list $undo $help]
00222
00223 ttk::labelframe .selhelp.f.exit -text [msgcat::mc "Exit Selection Mode"]
00224 switch $data($txtt,type) {
00225 block { create_list .selhelp.f.exit [list $ret $esc $del $inv] }
00226 default { create_list .selhelp.f.exit [list $ret $esc $del $inv $find] }
00227 }
00228
00229 # Pack the labelframes
00230 grid .selhelp.f.types -row 0 -column 0 -sticky news -padx 2 -pady 2 -rowspan 4
00231 grid .selhelp.f.motions -row 0 -column 1 -sticky news -padx 2 -pady 2
00232 grid .selhelp.f.anchors -row 1 -column 1 -sticky news -padx 2 -pady 2
00233 grid .selhelp.f.help -row 2 -column 1 -sticky news -padx 2 -pady 2
00234 grid .selhelp.f.exit -row 3 -column 1 -sticky news -padx 2 -pady 2
00235
00236 grid rowconfigure .selhelp 2 -weight 1
00237 grid columnconfigure .selhelp 0 -weight 1
00238 grid .selhelp.title -row 0 -column 0 -sticky ew
00239 grid .selhelp.close -row 0 -column 1 -sticky news
00240 grid .selhelp.sep -row 1 -column 0 -sticky ew -columnspan 2
00241 grid .selhelp.f -row 2 -column 0 -sticky news -columnspan 2
00242
00243 # Place the window in the middle of the main window
00244 ::tk::PlaceWindow .selhelp widget .
00245
00246 }
00247
00248 ######################################################################
00249 # Hide the help window from view.
00250 proc hide_help {} {
00251
00252 # Destroy the help window if it is displayed
00253 catch { destroy .selhelp }
00254
00255 }
00256
00257 ######################################################################
00258 # Create the motions list.
00259 proc create_list {w items {txtt ""}} {
00260
00261 variable data
00262
00263 set i 0
00264
00265 foreach item $items {
00266 lassign $item lbl shortcut type
00267 if {$type ne ""} {
00268 grid [ttk::label $w.c$i -text [expr {($data($txtt,type) eq $type) ? "\u2713" : " "}]] -row $i -column 0 -sticky news -padx 2 -pady 2
00269 }
00270 grid [ttk::label $w.s$i -text $shortcut -anchor e -width 3] -row $i -column 1 -sticky news -padx 4 -pady 2
00271 grid [ttk::label $w.l$i -text $lbl -anchor w -width 20] -row $i -column 2 -sticky news -padx 2 -pady 2
00272 incr i
00273 }
00274
00275 }
00276
00277 ######################################################################
00278 # Set the type information
00279 proc set_type {txtt value {init 1}} {
00280
00281 variable data
00282
00283 # Set the type
00284 set data($txtt,type) $value
00285
00286 # Update the selection
00287 if {$data($txtt,mode) && $init} {
00288 update_selection $txtt init
00289 }
00290
00291 # Update the position
00292 gui::update_position [winfo parent $txtt]
00293
00294 }
00295
00296 ######################################################################
00297 # Returns the current selection mode in use. The selection mode is
00298 # remembered even after we exit selection mode (until the selection
00299 # forgotten.
00300 proc get_type {txtt} {
00301
00302 variable data
00303
00304 if {[info exists data($txtt,type)]} {
00305 return $data($txtt,type)
00306 }
00307
00308 return "none"
00309
00310 }
00311
00312 ######################################################################
00313 # Updates the current selection based on the current type
00314 # selections along with the given motion type (init, next, prev, parent,
00315 # child).
00316 proc update_selection {txtt motion args} {
00317
00318 variable data
00319 variable positions
00320
00321 array set opts {
00322 -startpos ""
00323 }
00324 array set opts $args
00325
00326 # Get the current selection ranges
00327 set range [$txtt tag ranges sel]
00328 set number [expr {($data($txtt,number) eq "") ? 1 : $data($txtt,number)}]
00329 set data($txtt,number) ""
00330
00331 switch $motion {
00332 init {
00333 if {$opts(-startpos) ne ""} {
00334 $txtt mark set insert $opts(-startpos)
00335 } elseif {[llength $range] == 0} {
00336 $txtt mark set insert $data($txtt,anchor)
00337 } elseif {$data($txtt,anchorend) == 0} {
00338 $txtt mark set insert "insert-1 display chars"
00339 }
00340 switch $data($txtt,type) {
00341 char -
00342 block { set trange [list $data($txtt,anchor) "$data($txtt,anchor)+1 display chars"] }
00343 line -
00344 lineto {
00345 set trange [edit::get_range $txtt linestart lineend "" 0]
00346 if {$data($txtt,type) eq "lineto"} {
00347 lset trange $data($txtt,anchorend) $data($txtt,anchor)
00348 }
00349 }
00350 word {
00351 if {[string is space [$txtt get insert]]} {
00352 $txtt mark set insert [edit::get_index $txtt wordstart -dir [expr {($data($txtt,anchorend) == 0) ? "prev" : "next"}]]
00353 }
00354 set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] i 0]
00355 }
00356 sentence -
00357 paragraph {
00358 set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] o 0]
00359 }
00360 node { set trange [node_current [winfo parent $txtt] insert] }
00361 all -
00362 allto {
00363 set trange [list 1.0 end]
00364 if {$data($txtt,type) eq "allto"} {
00365 lset trange $data($txtt,anchorend) [lindex $range $data($txtt,anchorend)]
00366 }
00367 }
00368 comment {
00369 if {[set ranges [ctext::commentCharRanges [winfo parent $txtt] insert]] ne ""} {
00370 if {$data($txtt,inner)} {
00371 set trange [lrange $ranges 1 2]
00372 } else {
00373 set trange [list [lindex $ranges 0] [lindex $ranges end]]
00374 }
00375 } else {
00376 set trange $range
00377 }
00378 }
00379 single -
00380 double -
00381 btick { set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] [expr {$data($txtt,inner) ? "i" : "o"}] 0] }
00382 default { set trange [bracket_current $txtt $data($txtt,type) insert] }
00383 }
00384 if {[lsearch [list char line lineto word sentence paragraph] $data($txtt,type)] != -1} {
00385 if {$range eq ""} {
00386 set range $trange
00387 } else {
00388 if {[$txtt compare [lindex $trange 0] < [lindex $range 0]]} {
00389 lset range 0 [lindex $trange 0]
00390 }
00391 if {[$txtt compare [lindex $range 1] < [lindex $trange 1]]} {
00392 lset range 1 [lindex $trange 1]
00393 }
00394 }
00395 } else {
00396 set range $trange
00397 }
00398 }
00399 next -
00400 prev {
00401 set pos $positions($data($txtt,type))
00402 set index [expr $data($txtt,anchorend) ^ 1]
00403 switch $data($txtt,type) {
00404 line -
00405 lineto {
00406 set count ""
00407 if {[$txtt compare [lindex $range $index] == "[lindex $range $index] [lindex $pos $index]"]} {
00408 set count [expr {($motion eq "next") ? "+$number display lines" : "-$number display lines"}]
00409 }
00410 lset range $index [$txtt index "[lindex $range $index]$count [lindex $pos $index]"]
00411 }
00412 node {
00413 if {$data($txtt,anchorend) == 0} {
00414 if {[set node_range [node_${motion}_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
00415 lset range 1 [lindex $node_range 1]
00416 }
00417 } else {
00418 if {[set node_range [node_${motion}_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
00419 lset range 0 [lindex $node_range 0]
00420 }
00421 }
00422 }
00423 curly -
00424 square -
00425 paren -
00426 angled {
00427 if {$data($txtt,anchorend) == 0} {
00428 if {[set bracket_range [bracket_${motion}_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00429 lset range 1 [lindex $bracket_range 1]
00430 }
00431 } else {
00432 if {[set bracket_range [bracket_${motion}_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00433 lset range 0 [lindex $bracket_range 0]
00434 }
00435 }
00436 }
00437 default {
00438 if {($index == 1) && ($motion eq "prev") && ($data($txtt,type) eq "word")} {
00439 lset range 1 [$txtt index "[lindex $range 1]-1 display chars"]
00440 }
00441 if {$opts(-startpos) ne ""} {
00442 lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $motion -num $number -startpos $opts(-startpos)]
00443 } else {
00444 lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $motion -num $number -startpos [lindex $range $index]]
00445 }
00446 }
00447 }
00448 if {([lindex $range $index] eq "") || [$txtt compare [lindex $range 0] >= [lindex $range 1]]} {
00449 return
00450 }
00451 }
00452 rshift -
00453 lshift {
00454 if {$data($txtt,type) eq "block"} {
00455 set trange $range
00456 if {$motion eq "rshift"} {
00457 set range [list]
00458 foreach {startpos endpos} $trange {
00459 lappend range [$txtt index "$startpos+$number display chars"]
00460 if {[$txtt compare "$endpos+$number display chars" < "$endpos lineend"]} {
00461 lappend range [$txtt index "$endpos+$number display chars"]
00462 } else {
00463 lappend range [$txtt index "$endpos lineend"]
00464 }
00465 }
00466 } elseif {[$txtt compare "[lindex $range 0]-$number display chars" >= "[lindex $range 0] linestart"]} {
00467 set range [list]
00468 foreach {startpos endpos} $trange {
00469 lappend range [$txtt index "$startpos-$number display chars"] [$txtt index "$endpos-$number display chars"]
00470 }
00471 }
00472 } else {
00473 set pos $positions($data($txtt,type))
00474 set dir [expr {($motion eq "rshift") ? "next" : "prev"}]
00475 if {($motion eq "lshift") && ([lsearch [list word tag] $data($txtt,type)] != -1)} {
00476 lset range 1 [$txtt index "[lindex $range 1]-1 display chars"]
00477 }
00478 foreach index {0 1} {
00479 lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $dir -num $number -startpos [lindex $range $index]]
00480 }
00481 }
00482 }
00483 ushift {
00484 switch $data($txtt,type) {
00485 line {
00486 if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
00487 if {[$txtt compare [lindex $range 0] > 1.0]} {
00488 lset range 0 [$txtt index "[lindex $range 0]-$number display lines linestart"]
00489 lset range 1 [$txtt index "[lindex $range 1]-$number display lines lineend"]
00490 }
00491 }
00492 }
00493 node {
00494 if {[set node_range0 [node_prev_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
00495 if {[set node_range1 [node_prev_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
00496 lset range 0 [lindex $node_range0 0]
00497 lset range 1 [lindex $node_range1 1]
00498 }
00499 }
00500 }
00501 curly -
00502 square -
00503 paren -
00504 angled {
00505 if {[set bracket_range0 [bracket_prev_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00506 if {[set bracket_range1 [bracket_prev_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00507 lset range 0 [lindex $bracket_range0 0]
00508 lset range 1 [lindex $bracket_range1 1]
00509 }
00510 }
00511 }
00512 default {
00513 if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
00514 set trange $range
00515 set range [list]
00516 foreach {pos} $trange {
00517 lappend range [$txtt index "$pos-$number display lines"]
00518 }
00519 }
00520 }
00521 }
00522 }
00523 dshift {
00524 switch $data($txtt,type) {
00525 line {
00526 if {[$txtt compare "[lindex $range end]+$number display lines" > "[lindex $range end] lineend"]} {
00527 if {[$txtt compare [lindex $range 1] < "end-1 display lines lineend"]} {
00528 lset range 1 [$txtt index "[lindex $range 1]+$number display lines lineend"]
00529 lset range 0 [$txtt index "[lindex $range 0]+$number display lines linestart"]
00530 }
00531 }
00532 }
00533 node {
00534 if {[set node_range1 [node_next_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
00535 if {[set node_range0 [node_next_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
00536 lset range 0 [lindex $node_range0 0]
00537 lset range 1 [lindex $node_range1 1]
00538 }
00539 }
00540 }
00541 curly -
00542 square -
00543 paren -
00544 angled {
00545 if {[set bracket_range0 [bracket_next_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00546 if {[set bracket_range1 [bracket_next_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
00547 lset range 0 [lindex $bracket_range0 0]
00548 lset range 1 [lindex $bracket_range1 1]
00549 }
00550 }
00551 }
00552 default {
00553 if {[$txtt compare "[lindex $range end]+$number display lines" > "[lindex $range end] lineend"]} {
00554 set trange $range
00555 set range [list]
00556 foreach {pos} $trange {
00557 lappend range [$txtt index "$pos+$number display lines"]
00558 }
00559 }
00560 }
00561 }
00562 }
00563 left {
00564 if {$data($txtt,anchorend) == 1} {
00565 set i 0
00566 foreach {startpos endpos} $range {
00567 if {[$txtt compare "$startpos-$number display chars" >= "$startpos linestart"]} {
00568 lset range $i [$txtt index "$startpos-$number display chars"]
00569 incr i 2
00570 }
00571 }
00572 } else {
00573 set i 1
00574 foreach {startpos endpos} $range {
00575 if {[$txtt compare "$endpos-$number display chars" > $startpos]} {
00576 lset range $i [$txtt index "$endpos-$number display chars"]
00577 }
00578 incr i 2
00579 }
00580 }
00581 }
00582 right {
00583 if {$data($txtt,anchorend) == 1} {
00584 set i 0
00585 foreach {startpos endpos} $range {
00586 if {[$txtt compare "$startpos+$number display chars" < $endpos]} {
00587 lset range $i [$txtt index "$startpos+$number display chars"]
00588 }
00589 incr i 2
00590 }
00591 } else {
00592 set i 1
00593 foreach {startpos endpos} $range {
00594 if {[$txtt compare "$endpos+$number display chars" <= "$endpos lineend"]} {
00595 lset range $i [$txtt index "$endpos+$number display chars"]
00596 }
00597 incr i 2
00598 }
00599 }
00600 }
00601 up {
00602 if {$data($txtt,type) eq "block"} {
00603 if {$data($txtt,anchorend) == 1} {
00604 if {[$txtt compare "insert-$number display lines" < [lindex $range 0]]} {
00605 set nrow [lindex [split [$txtt index "insert-$number display lines"] .] 0]
00606 set ocol1 [$txtt count -displaychars "[lindex $range end-1] linestart" [lindex $range end-1]]
00607 set ocol2 [$txtt count -displaychars "[lindex $range end] linestart" [lindex $range end]]
00608 for {set i 0} {$i < $number} {incr i} {
00609 lappend trange $nrow.$ocol1 $nrow.$ocol2
00610 incr nrow
00611 }
00612 set range [list {*}$trange {*}$range]
00613 }
00614 } else {
00615 if {[$txtt compare "insert-$number display lines" >= [lindex $range 0]]} {
00616 set range [lreplace $range end-[expr ($number * 2) - 1] end]
00617 }
00618 }
00619 } else {
00620 if {$data($txtt,anchorend) == 1} {
00621 if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
00622 lset range 0 [$txtt index "[lindex $range 0]-$number display lines"]
00623 }
00624 } else {
00625 if {[$txtt compare "[lindex $range 1]-$number display lines" > [lindex $range 0]]} {
00626 lset range 1 [$txtt index "[lindex $range 1]-$number display lines"]
00627 }
00628 }
00629 }
00630 }
00631 down {
00632 if {$data($txtt,type) eq "block"} {
00633 if {$data($txtt,anchorend) == 1} {
00634 if {[$txtt compare "insert+$number display lines" <= [lindex $range end-1]]} {
00635 set range [lreplace $range 0 [expr ($number * 2) - 1]]
00636 }
00637 } else {
00638 if {[$txtt compare "insert+$number display lines" < end]} {
00639 set nrow [lindex [split [$txtt index "insert+$number display lines"] .] 0]
00640 set ocol1 [$txtt count -displaychars "[lindex $range 0] linestart" [lindex $range 0]]
00641 set ocol2 [$txtt count -displaychars "[lindex $range 1] linestart" [lindex $range 1]]
00642 for {set i 0} {$i < $number} {incr i} {
00643 lappend trange $nrow.$ocol2 $nrow.$ocol1
00644 incr nrow -1
00645 }
00646 lappend range {*}[lreverse $trange]
00647 }
00648 }
00649 } else {
00650 if {$data($txtt,anchorend) == 1} {
00651 if {[$txtt compare "[lindex $range 0]+$number display lines" < [lindex $range 1]]} {
00652 lset range 0 [$txtt index "[lindex $range 0]+$number display lines"]
00653 }
00654 } else {
00655 if {[$txtt compare "[lindex $range 1]+$number display lines" < end]} {
00656 lset range 1 [$txtt index "[lindex $range 1]+$number display lines"]
00657 }
00658 }
00659 }
00660 }
00661 parent {
00662 switch $data($txtt,type) {
00663 node { set trange [node_parent [winfo parent $txtt] {*}$range] }
00664 default { set trange [bracket_parent $txtt $data($txtt,type) {*}$range] }
00665 }
00666 if {$trange ne ""} {
00667 set range $trange
00668 }
00669 }
00670 child {
00671 if {$data($txtt,anchorend) == 0} {
00672 switch $data($txtt,type) {
00673 node { set trange [node_first_child [winfo parent $txtt] [lindex $range 0]] }
00674 default { set trange [bracket_first_child $txtt $data($txtt,type) {*}$range] }
00675 }
00676 } else {
00677 switch $data($txtt,type) {
00678 node { set trange [node_last_child [winfo parent $txtt] [lindex $range 0]] }
00679 default { set trange [bracket_last_child $txtt $data($txtt,type) {*}$range] }
00680 }
00681 }
00682 if {$trange ne ""} {
00683 set range $trange
00684 }
00685 }
00686 }
00687
00688 # If the range was not set to a valid range, return now
00689 if {[set cursor [lindex $range [expr {$data($txtt,anchorend) ? 0 : "end"}]]] eq ""} {
00690 return
00691 }
00692
00693 # Set the cursor and selection
00694 set data($txtt,dont_close) 1
00695 set index [expr {($data($txtt,anchorend) == 0) ? 0 : "end"}]
00696 set data($txtt,anchor) [lindex $range $index]
00697 ::tk::TextSetCursor $txtt $cursor
00698 foreach {startpos endpos} $range {
00699 $txtt tag add sel $startpos $endpos
00700 }
00701
00702 # Add the information to the undo buffer
00703 lappend data($txtt,undo) [list $data($txtt,type) $data($txtt,anchorend) $range]
00704
00705 }
00706
00707 ######################################################################
00708 # Clears the selection in such a way that will keep selection mode
00709 # enabled.
00710 proc clear_selection {txtt} {
00711
00712 variable data
00713
00714 # Indicate to handle_selection that we don't want to exit selection mode
00715 set data($txtt,dont_close) 1
00716
00717 # Clear the selection
00718 $txtt tag remove sel 1.0 end
00719
00720 }
00721
00722 ######################################################################
00723 # Returns true if the given text widget is currently in selection mode;
00724 # otherwise, returns false.
00725 proc in_select_mode {txtt ptype} {
00726
00727 upvar $ptype type
00728
00729 variable data
00730
00731 if {![info exists data($txtt,mode)]} {
00732 return 0
00733 }
00734
00735 set type $data($txtt,type)
00736
00737 return $data($txtt,mode)
00738
00739 }
00740
00741 ######################################################################
00742 # Sets the selection mode for the given text widget to the given value.
00743 # This will cause the selection bar to appear or disappear as needed.
00744 proc set_select_mode {txtt value} {
00745
00746 variable data
00747
00748 # Set the mode
00749 if {$data($txtt,mode) != $value} {
00750
00751 # Set the mode to the given value
00752 set data($txtt,mode) $value
00753
00754 # If we are enabled, do some initializing
00755 if {$value} {
00756
00757 set data($txtt,anchor) [$txtt index insert]
00758 set data($txtt,anchorend) 0
00759 set data($txtt,undo) [list]
00760
00761 # If text was not previously selected, select it by word
00762 if {[set sel [$txtt tag ranges sel]] eq ""} {
00763 set_type $txtt "word" 1
00764 } elseif {$data($txtt,type) eq "none"} {
00765 set_type $txtt "char" 0
00766 }
00767
00768 # Configure the cursor
00769 $txtt configure -cursor [ttk::cursor standard]
00770
00771 # Display a help message
00772 gui::set_info_message [msgcat::mc "Type '?' for help. Hit the ESCAPE key to exit selection mode"] -win [winfo parent $txtt] -clear_delay 0
00773
00774 # Otherwise, configure the cursor
00775 } else {
00776
00777 $txtt configure -cursor ""
00778
00779 # Clear the help message
00780 gui::set_info_message "" -win [winfo parent $txtt]
00781
00782 }
00783
00784 # Make sure that the information bar is updated appropriately
00785 gui::update_position [winfo parent $txtt]
00786
00787 }
00788
00789 }
00790
00791 ######################################################################
00792 # If we ever lose the selection, automatically exit selection mode.
00793 proc handle_selection {txtt} {
00794
00795 variable data
00796
00797 if {([$txtt tag ranges sel] eq "") && !$data($txtt,dont_close)} {
00798 set_select_mode $txtt 0
00799 set data($txtt,type) "none"
00800 }
00801
00802 # Clear the dont_close indicator
00803 set data($txtt,dont_close) 0
00804
00805 # Hide the help display if it is in view
00806 hide_help
00807
00808 }
00809
00810 ######################################################################
00811 # Handles a FocusOut event on the given text widget.
00812 proc handle_focusout {txtt} {
00813
00814 # Hide the help window if we lose focus
00815 hide_help
00816
00817 }
00818
00819 ######################################################################
00820 # Handles the Return key when in selection mode. Ends selection mode,
00821 # leaving the selection in place.
00822 proc handle_return {txtt} {
00823
00824 variable data
00825
00826 if {$data($txtt,mode) == 0} {
00827 return 0
00828 }
00829
00830 # Disable selection mode
00831 set_select_mode $txtt 0
00832
00833 # Allow Vim to remember this selection
00834 vim::set_last_selection $txtt
00835
00836 # Hide the help window if it is displayed
00837 hide_help
00838
00839 return 1
00840
00841 }
00842
00843 ######################################################################
00844 # Handles the Escape key when in selection mode. Ends selection mode
00845 # and clears the selection.
00846 proc handle_escape {txtt} {
00847
00848 variable data
00849
00850 if {$data($txtt,mode) == 0} {
00851 return 0
00852 }
00853
00854 # This is only necessary for BIST testing on MacOS, but it should not hurt
00855 # anything to clear the type anyways
00856 set data($txtt,type) "none"
00857 set_select_mode $txtt 0
00858
00859 # Clear the selection
00860 $txtt tag remove sel 1.0 end
00861
00862 return 1
00863
00864 }
00865
00866 ######################################################################
00867 # Handles the BackSpace key when in selection mode. Ends selection
00868 # mode and deletes the selected text.
00869 proc handle_backspace {txtt} {
00870
00871 variable data
00872
00873 if {$data($txtt,mode) == 0} {
00874 return 0
00875 }
00876
00877 # Delete the text
00878 if {![multicursor::delete $txtt [list char -dir prev] ""]} {
00879 edit::delete $txtt {*}[lrange [$txtt tag ranges sel] 0 1] 1 1
00880 }
00881
00882 # Disable selection mode
00883 set_select_mode $txtt 0
00884 set data($txtt,type) "none"
00885
00886 # Hide the help window
00887 hide_help
00888
00889 return 1
00890
00891 }
00892
00893 ######################################################################
00894 # Handles the BackSpace or Delete key when in selection mode. Ends
00895 # selection mode and deletes the selected text.
00896 proc handle_delete {txtt} {
00897
00898 variable data
00899
00900 if {$data($txtt,mode) == 0} {
00901 return 0
00902 }
00903
00904 # Delete the text
00905 if {![multicursor::delete $txtt [list char -dir next] ""]} {
00906 edit::delete $txtt {*}[lrange [$txtt tag ranges sel] 0 1] 1 1
00907 }
00908
00909 # Disable selection mode
00910 set_select_mode $txtt 0
00911 set data($txtt,type) "none"
00912
00913 # Hide the help window
00914 hide_help
00915
00916 return 1
00917
00918 }
00919
00920 ######################################################################
00921 # Inverts the current selection and ends selection mode.
00922 proc handle_asciitilde {txtt} {
00923
00924 variable data
00925
00926 if {$data($txtt,mode) == 0} {
00927 return 0
00928 }
00929
00930 # Get the current selection
00931 set ranges [$txtt tag ranges sel]
00932
00933 # Select everything and remove the given ranges
00934 $txtt tag add sel 1.0 end
00935 $txtt tag remove sel {*}$ranges
00936
00937 # Disable selection mode
00938 set_select_mode $txtt 0
00939 set data($txtt,type) "none"
00940
00941 # Hide the help window
00942 hide_help
00943
00944 return 1
00945
00946 }
00947
00948 ######################################################################
00949 # Selection mode completion command which finds all text that matches
00950 # currently selected text and includes those in the selection.
00951 proc handle_slash {txtt} {
00952
00953 variable data
00954
00955 if {$data($txtt,mode) == 0} {
00956 return 0
00957 }
00958
00959 # Get the selection string to match against
00960 set str [$txtt get sel.first sel.last]
00961
00962 # Find all text in the editing buffer that matches the selected text
00963 set i 0
00964 foreach index [$txtt search -all -count lengths -forward -- $str 1.0 end] {
00965 $txtt tag add sel $index "$index+[lindex $lengths $i]c"
00966 incr i
00967 }
00968
00969 # Disable selection mode
00970 set_select_mode $txtt 0
00971 set data($txtt,type) "none"
00972
00973 # Hide the help window
00974 hide_help
00975
00976 # Tell the user how many matches we found
00977 gui::set_info_message [format "%s %d %s" [msgcat::mc "Selected"] [expr $i - 1] [msgcat::mc "matching instances"]]
00978
00979 return 1
00980
00981 }
00982
00983 ######################################################################
00984 # Handle a single click event press event.
00985 proc handle_single_press {txtt x y} {
00986
00987 variable data
00988
00989 # Change the anchor end
00990 set data($txtt,anchorend) 0
00991
00992 # Set the anchor
00993 set data($txtt,anchor) [$txtt index @$x,$y]
00994
00995 # Set the insertion cursor
00996 $txtt mark set insert $data($txtt,anchor)
00997
00998 return 0
00999
01000 }
01001
01002 ######################################################################
01003 # Handle a single click event release event.
01004 proc handle_single_release {txtt x y} {
01005
01006 return 1
01007
01008 }
01009
01010 ######################################################################
01011 # Handles a double-click event within the editing buffer.
01012 proc handle_double_click {txtt x y} {
01013
01014 # Set the selection type to inner word
01015 set_type $txtt word
01016
01017 return 0
01018
01019 }
01020
01021 ######################################################################
01022 # Handles a double-click while the Control key is pressed. Selects the
01023 # current sentence.
01024 proc handle_control_double_click {txtt x y} {
01025
01026 # Set the selection type to sentence
01027 set_type $txtt sentence
01028
01029 # Update the selection
01030 update_selection $txtt init -startpos [$txtt index @$x,$y]
01031
01032 return 1
01033
01034 }
01035
01036 ######################################################################
01037 # Returns the current bracket type based on the position of startpos.
01038 proc get_bracket_type {txtt startpos} {
01039
01040 set type ""
01041
01042 # If we are within a comment, return
01043 if {[$txtt is incomment $startpos]} {
01044 return comment
01045 } elseif {[$txtt is instring $startpos]} {
01046 if {[$txtt is insingle $startpos]} {
01047 set type single
01048 } elseif {[$txtt is indouble $startpos]} {
01049 set type double
01050 } else {
01051 set type btick
01052 }
01053 } else {
01054 set closest ""
01055 foreach t [list square curly paren angled] {
01056 if {[$txtt is $t $startpos]} {
01057 set type $t
01058 break
01059 } elseif {[set index [ctext::getMatchBracket [winfo parent $txtt] ${t}L $startpos]] ne ""} {
01060 if {($closest eq "") || [$txtt compare $index > $closest]} {
01061 set type $t
01062 set closest $index
01063 }
01064 }
01065 }
01066 }
01067
01068 return $type
01069
01070 }
01071
01072 ######################################################################
01073 # Handles a double-click event while the Shift-Control keys are held.
01074 # Selects the current square, curly, paren, single, double, backtick or tag.
01075 proc handle_shift_control_double_click {txtt x y} {
01076
01077 # Get the bracket type closest to the mouse cursor
01078 if {[set type [get_bracket_type $txtt [$txtt index @$x,$y]]] ne ""} {
01079
01080 # Set the type
01081 set_type $txtt $type
01082
01083 # Update the selection
01084 update_selection $txtt init -startpos [$txtt index @$x,$y]
01085
01086 }
01087
01088 return 1
01089
01090 }
01091
01092 ######################################################################
01093 # Handles a triple-click event within the editing buffer. Selects a
01094 # line of text.
01095 proc handle_triple_click {txtt x y} {
01096
01097 # Set the selection type to inner line
01098 set_type $txtt line
01099
01100 return 0
01101
01102 }
01103
01104 ######################################################################
01105 # Handles a triple-click when the Control key is down. Selects a paragraph
01106 # of text.
01107 proc handle_control_triple_click {txtt x y} {
01108
01109 # Set the selection type to paragraph
01110 set_type $txtt paragraph
01111
01112 # Update the selection
01113 update_selection $txtt init -startpos [$txtt index @$x,$y]
01114
01115 return 1
01116
01117 }
01118
01119 ######################################################################
01120 # Handles a triple-click while the Shift-Control keys are held. Selects
01121 # the current XML node.
01122 proc handle_shift_control_triple_click {txtt x y} {
01123
01124 # Set the selection type to node
01125 set_type $txtt node
01126
01127 # Update the selection
01128 update_selection $txtt init -startpos [$txtt index @$x,$y]
01129
01130 return 1
01131
01132 }
01133
01134 ######################################################################
01135 # Performs the block selection.
01136 proc handle_block_selection {txtt anchor current} {
01137
01138 # Get the anchor and current row/col, but if either is invalid, return immediately
01139 if {[set acol [lassign [split $anchor .] arow]] eq ""} {
01140 return
01141 }
01142 if {[set ccol [lassign [split $current .] crow]] eq ""} {
01143 return
01144 }
01145
01146 if {$arow < $crow} {
01147 set srow $arow
01148 set erow $crow
01149 } else {
01150 set srow $crow
01151 set erow $arow
01152 }
01153
01154 if {$acol < $ccol} {
01155 set scol $acol
01156 set ecol $ccol
01157 } else {
01158 set scol $ccol
01159 set ecol $acol
01160 }
01161
01162 # Set the selection
01163 clear_selection $txtt
01164 for {set i $srow} {$i <= $erow} {incr i} {
01165 $txtt tag add sel $i.$scol $i.$ecol
01166 }
01167
01168 }
01169
01170 ######################################################################
01171 # Performs a block selection.
01172 proc handle_alt_motion {txtt x y} {
01173
01174 variable data
01175
01176 handle_block_selection $txtt $data($txtt,anchor) [$txtt index @$x,$y]
01177
01178 return 1
01179
01180 }
01181
01182 ######################################################################
01183 # Handles any other entered keys when in selection mode.
01184 proc handle_any {txtt keysym} {
01185
01186 variable data
01187
01188 if {$data($txtt,mode) == 0} {
01189 return 0
01190 }
01191
01192 # Check to see if the selection window exists
01193 set help_existed [winfo exists .selhelp]
01194
01195 # If the keysym is a number, append the number to the current one.
01196 if {[string is integer $keysym]} {
01197 if {($keysym ne "0") || ($data($txtt,number) ne "")} {
01198 append data($txtt,number) $keysym
01199 }
01200
01201 # Handle the specified key, if a handler exists for it
01202 } elseif {[info procs handle_$keysym] ne ""} {
01203 handle_$keysym $txtt
01204 }
01205
01206 # Hide the help window if it is displayed
01207 if {$help_existed} {
01208 hide_help
01209 }
01210
01211 return 1
01212
01213 }
01214
01215 ######################################################################
01216 # Sets the current selection type to character mode.
01217 proc handle_c {txtt} {
01218
01219 # Make sure that char is selected
01220 set_type $txtt char
01221
01222 }
01223
01224 ######################################################################
01225 # Sets the current selection type to line mode.
01226 proc handle_e {txtt} {
01227
01228 set_type $txtt line
01229
01230 }
01231
01232 ######################################################################
01233 # Sets the current selection type from anchor to beginning/end of line.
01234 proc handle_E {txtt} {
01235
01236 set_type $txtt lineto
01237
01238 }
01239
01240 ######################################################################
01241 # Sets the current selection type to block mode.
01242 proc handle_b {txtt} {
01243
01244 set_type $txtt block
01245
01246 }
01247
01248 ######################################################################
01249 # Set the current selection type to word mode.
01250 proc handle_w {txtt} {
01251
01252 set_type $txtt word
01253
01254 }
01255
01256 ######################################################################
01257 # Set the current selection type to sentence mode.
01258 proc handle_s {txtt} {
01259
01260 set_type $txtt sentence
01261
01262 }
01263
01264 ######################################################################
01265 # Set the current selection type to paragraph mode.
01266 proc handle_p {txtt} {
01267
01268 set_type $txtt paragraph
01269
01270 }
01271
01272 ######################################################################
01273 # Set the current selection type to node mode.
01274 proc handle_n {txtt} {
01275
01276 set_type $txtt node
01277
01278 }
01279
01280 ######################################################################
01281 # Set the current selection type to curly mode.
01282 proc handle_braceleft {txtt} {
01283
01284 set_type $txtt curly
01285
01286 }
01287
01288 ######################################################################
01289 # Set the current selection type to parenthesis mode.
01290 proc handle_parenleft {txtt} {
01291
01292 set_type $txtt paren
01293
01294 }
01295
01296 ######################################################################
01297 # Set the current selection type to angled mode.
01298 proc handle_less {txtt} {
01299
01300 set_type $txtt angled
01301
01302 }
01303
01304 ######################################################################
01305 # Set the current selection type to square mode.
01306 proc handle_bracketleft {txtt} {
01307
01308 set_type $txtt square
01309
01310 }
01311
01312 ######################################################################
01313 # Set the current selection type to double quote mode.
01314 proc handle_quotedbl {txtt} {
01315
01316 set_type $txtt double
01317
01318 }
01319
01320 ######################################################################
01321 # Set the current selection type to single quote mode.
01322 proc handle_quoteright {txtt} {
01323
01324 set_type $txtt single
01325
01326 }
01327
01328 ######################################################################
01329 # Set the current selection type to backtick mode.
01330 proc handle_quoteleft {txtt} {
01331
01332 set_type $txtt btick
01333
01334 }
01335
01336 ######################################################################
01337 # Set the current selection type to comment.
01338 proc handle_numbersign {txtt} {
01339
01340 set_type $txtt comment
01341
01342 }
01343
01344 ######################################################################
01345 # Set the current selection type to all.
01346 proc handle_asterisk {txtt} {
01347
01348 set_type $txtt all
01349
01350 }
01351
01352 ######################################################################
01353 # Set the current selection type to allto.
01354 proc handle_period {txtt} {
01355
01356 set_type $txtt allto
01357
01358 }
01359
01360 ######################################################################
01361 # Handles moving the selection back by the selection type amount.
01362 proc handle_H {txtt} {
01363
01364 variable data
01365
01366 switch $data($txtt,type) {
01367 all -
01368 allto -
01369 line -
01370 lineto -
01371 single -
01372 double -
01373 btick -
01374 comment {}
01375 node -
01376 curly -
01377 square -
01378 paren -
01379 angled { update_selection $txtt parent }
01380 default { update_selection $txtt lshift }
01381 }
01382
01383 }
01384
01385 ######################################################################
01386 # Handles moving the selection forward by the selection type amount.
01387 proc handle_L {txtt} {
01388
01389 variable data
01390
01391 switch $data($txtt,type) {
01392 all -
01393 allto -
01394 line -
01395 lineto -
01396 single -
01397 double -
01398 btick -
01399 comment {}
01400 node -
01401 curly -
01402 square -
01403 paren -
01404 angled { update_selection $txtt child }
01405 default { update_selection $txtt rshift }
01406 }
01407
01408 }
01409
01410 ######################################################################
01411 # Handles moving the entire selection to include the parent of the
01412 # currently selected text.
01413 proc handle_K {txtt} {
01414
01415 variable data
01416
01417 switch $data($txtt,type) {
01418 char -
01419 block -
01420 node -
01421 line -
01422 lineto -
01423 curly -
01424 square -
01425 paren -
01426 angled { update_selection $txtt ushift }
01427 }
01428
01429 }
01430
01431 ######################################################################
01432 # Handles moving the entire selection to include just the first child
01433 # of the currently selected text.
01434 proc handle_J {txtt} {
01435
01436 variable data
01437
01438 switch $data($txtt,type) {
01439 char -
01440 block -
01441 node -
01442 line -
01443 lineto -
01444 curly -
01445 square -
01446 paren -
01447 angled { update_selection $txtt dshift }
01448 }
01449
01450 }
01451
01452 ######################################################################
01453 # Handles moving the entire selection to the left by the current type.
01454 proc handle_h {txtt} {
01455
01456 variable data
01457
01458 switch $data($txtt,type) {
01459 node -
01460 square -
01461 curly -
01462 paren -
01463 angled { update_selection $txtt parent }
01464 block { update_selection $txtt left }
01465 char -
01466 line -
01467 lineto -
01468 word -
01469 sentence -
01470 paragraph { update_selection $txtt prev }
01471 }
01472
01473 }
01474
01475 ######################################################################
01476 # Handles moving the entire selection to the right by the current type.
01477 proc handle_l {txtt} {
01478
01479 variable data
01480
01481 switch $data($txtt,type) {
01482 node -
01483 curly -
01484 square -
01485 paren -
01486 angled { update_selection $txtt child }
01487 block { update_selection $txtt right }
01488 char -
01489 line -
01490 lineto -
01491 word -
01492 sentence -
01493 paragraph { update_selection $txtt next }
01494 }
01495
01496 }
01497
01498 ######################################################################
01499 # If the selection mode is char or block, handles moving the cursor up
01500 # a line (carries the selection with it).
01501 proc handle_k {txtt} {
01502
01503 variable data
01504
01505 switch $data($txtt,type) {
01506 char -
01507 block { update_selection $txtt up }
01508 node -
01509 line -
01510 lineto -
01511 curly -
01512 square -
01513 paren -
01514 angled { update_selection $txtt prev }
01515 }
01516
01517 }
01518
01519 ######################################################################
01520 # If the selection mode is char or block, handles moving the cursor
01521 # down a line (carries the selection with it).
01522 proc handle_j {txtt} {
01523
01524 variable data
01525
01526 switch $data($txtt,type) {
01527 char -
01528 block { update_selection $txtt down }
01529 node -
01530 line -
01531 lineto -
01532 curly -
01533 square -
01534 paren -
01535 angled { update_selection $txtt next }
01536 }
01537
01538 }
01539
01540 ######################################################################
01541 # Changes the selection anchor to the other side of the selection.
01542 proc handle_a {txtt} {
01543
01544 variable data
01545
01546 # Get the selected ranges (if none is set, return immediately)
01547 if {[set sel [$txtt tag ranges sel]] eq ""} {
01548 return
01549 }
01550
01551 # Change the anchor end
01552 set data($txtt,anchorend) [expr $data($txtt,anchorend) ^ 1]
01553
01554 # Set the anchor
01555 if {$data($txtt,anchorend)} {
01556 set data($txtt,anchor) [lindex $sel end]
01557 set cursor [lindex $sel 0]
01558 } else {
01559 set data($txtt,anchor) [lindex $sel 0]
01560 set cursor [lindex $sel end]
01561 }
01562
01563 # Move the insertion cursor to the new anchor position
01564 $txtt mark set insert $cursor
01565 $txtt see $cursor
01566
01567 }
01568
01569 ######################################################################
01570 # Causes the surrounding characters to be included/excluded from the
01571 # selection. This is only valid for types which include surrounding
01572 # characters.
01573 proc handle_i {txtt} {
01574
01575 variable data
01576
01577 if {[lsearch [list single double btick comment] $data($txtt,type)] != -1} {
01578 set data($txtt,inner) [expr {$data($txtt,inner) ^ 1}]
01579 update_selection $txtt init
01580 }
01581
01582 }
01583
01584 ######################################################################
01585 # Undo selection.
01586 proc handle_u {txtt} {
01587
01588 undo $txtt
01589
01590 }
01591
01592 ######################################################################
01593 # Displays the cheatsheet.
01594 proc handle_question {txtt} {
01595
01596 show_help $txtt
01597
01598 }
01599
01600 ######################################################################
01601 # Handles a button press on a given tag.
01602 proc press {txtt tag} {
01603
01604 variable data
01605
01606 set data($txtt,drag) $tag
01607
01608 }
01609
01610 ######################################################################
01611 # Handles a button release on a given tag.
01612 proc release {txtt} {
01613
01614 variable data
01615
01616 unset -nocomplain data($txtt,drag)
01617
01618 }
01619
01620 ######################################################################
01621 # Handles an enter event when the user enters the given tag.
01622 proc handle_enter {txtt tag} {
01623
01624 # Get the base color of the selection
01625 set color [$txtt tag cget sel -background]
01626
01627 # Set the color of the start/end tag to an adjusted color from the selection color
01628 $txtt tag configure $tag -background [utils::auto_adjust_color $color 40]
01629
01630 }
01631
01632 ######################################################################
01633 # Handles a leave event when the user leaves the given tag.
01634 proc handle_leave {txtt tag} {
01635
01636 # Remove the background color of the tag
01637 $txtt tag configure $tag -background ""
01638
01639 }
01640
01641 ######################################################################
01642 # Returns the range of the current DOM.
01643 proc node_current {txt startpos} {
01644
01645 if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
01646 return [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
01647 } elseif {[lindex $tag 3] eq "010"} {
01648 return [lrange $tag 0 1]
01649 } else {
01650 return [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
01651 }
01652 }
01653
01654 ######################################################################
01655 # Returns the starting and ending positions of the parent HTML node given
01656 # the starting cursor position.
01657 proc node_parent {txt startpos endpos} {
01658
01659 set within [emmet::get_node_range_within $txt -startpos $startpos]
01660
01661 if {(([set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq "") && ([lindex $tag 3] ne "010")) || \
01662 ([emmet::get_inner $within] eq [list $startpos $endpos])} {
01663 return [emmet::get_outer $within]
01664 } else {
01665 return [emmet::get_inner $within]
01666 }
01667
01668 }
01669
01670 ######################################################################
01671 # Returns the starting and ending positions of the first child node in the
01672 # DOM. The startpos parameter should be the index of the start of the parent
01673 # node.
01674 proc node_first_child {txt startpos} {
01675
01676 set parent_range [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
01677
01678 if {[emmet::inside_tag $txt -startpos $startpos -allow010 1] eq ""} {
01679 if {[set tag [emmet::get_tag $txt -dir next -type ??0 -start [lindex $parent_range 0]]] ne ""} {
01680 if {[$txt compare [lindex $tag 0] < [lindex $parent_range 1]]} {
01681 if {[lindex $tag 3] eq "010"} {
01682 return [lrange $tag 0 1]
01683 } else {
01684 return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
01685 }
01686 }
01687 }
01688 } elseif {($parent_range eq "") || [$txt compare [lindex $parent_range 0] == [lindex $parent_range 1]]} {
01689 return ""
01690 }
01691
01692 return $parent_range
01693
01694 }
01695
01696 ######################################################################
01697 # Returns the starting and ending positions of the last child node in the
01698 # DOM. The startpos parameter should be the index of the start of the
01699 # parent node.
01700 proc node_last_child {txt startpos} {
01701
01702 set parent_range [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
01703
01704 if {[emmet::inside_tag $txt -startpos $startpos -allow010 1] eq ""} {
01705 if {[set tag [emmet::get_tag $txt -dir prev -type ??0 -start [lindex $parent_range 1]]] ne ""} {
01706 if {[$txt compare [lindex $tag 0] > [lindex $parent_range 0]]} {
01707 if {[lindex $tag 3] eq "010"} {
01708 return [lrange $tag 0 1]
01709 } else {
01710 return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
01711 }
01712 }
01713 }
01714 } elseif {($parent_range eq "") || [$txt compare [lindex $parent_range 0] == [lindex $parent_range 1]]} {
01715 return ""
01716 }
01717
01718 return $parent_range
01719
01720 }
01721
01722 ######################################################################
01723 # Returns the starting and ending positions of the next sibling node of
01724 # the node containing the given starting position.
01725 proc node_next_sibling {txt startpos} {
01726
01727 if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
01728 return ""
01729 }
01730
01731 if {[lindex $tag 3] eq "010"} {
01732 set current_range [lrange $tag 0 1]
01733 } else {
01734 set current_range [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
01735 }
01736 set parent_range [node_parent $txt {*}$current_range]
01737
01738 if {[set tag [emmet::get_tag $txt -dir next -type ??0 -start [lindex $current_range 1]]] ne ""} {
01739 if {($parent_range eq "") || [$txt compare [lindex $tag 0] < [lindex $parent_range 1]]} {
01740 if {[lindex $tag 3] eq "010"} {
01741 return [lrange $tag 0 1]
01742 } else {
01743 return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
01744 }
01745 }
01746 }
01747
01748 return ""
01749
01750 }
01751
01752 ######################################################################
01753 # Returns the starting and ending positions of the next sibling node of
01754 # the node containing the given starting position.
01755 proc node_prev_sibling {txt startpos} {
01756
01757 if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
01758 return ""
01759 }
01760
01761 if {[lindex $tag 3] eq "010"} {
01762 set current_range [lrange $tag 0 1]
01763 } else {
01764 set current_range [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
01765 }
01766 set parent_range [node_parent $txt {*}$current_range]
01767
01768 if {[set tag [emmet::get_tag $txt -dir prev -type 0?? -start "[lindex $current_range 0]-1c"]] ne ""} {
01769 if {($parent_range eq "") || [$txt compare [lindex $tag 0] > [lindex $parent_range 0]]} {
01770 if {[lindex $tag 3] eq "010"} {
01771 return [lrange $tag 0 1]
01772 } else {
01773 return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
01774 }
01775 }
01776 }
01777
01778 return ""
01779
01780 }
01781
01782 ######################################################################
01783 # Returns the range of the specified bracket.
01784 proc bracket_current {txtt type startpos} {
01785
01786 if {[$txtt is $type $startpos]} {
01787 return [edit::get_range $txtt [list $type 1] [list] o 0 $startpos]
01788 } else {
01789 return [edit::get_range $txtt [list $type 1] [list] i 0 $startpos]
01790 }
01791
01792 }
01793
01794 ######################################################################
01795 # Returns the range of the specified bracket's parent bracket.
01796 proc bracket_parent {txtt type startpos endpos} {
01797
01798 if {[$txtt is $type left $startpos]} {
01799 set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos]
01800 if {[$txtt compare $right == $endpos-1c]} {
01801 if {[$txtt is $type left $startpos-1c]} {
01802 return [list $startpos [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos-1c]]
01803 } else {
01804 return [edit::get_range $txtt [list $type 1] [list] i 0 "$startpos-1c"]
01805 }
01806 } elseif {[$txtt is $type left $startpos-1c]} {
01807 return [list [$txtt index $startpos-1c] [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos-1c]+1c]
01808 }
01809 }
01810
01811 if {[set trange [edit::get_range $txtt [list $type 1] [list] o 0 "$startpos-1c"]] eq [list "" ""]} {
01812 return ""
01813 }
01814
01815 return $trange
01816
01817 }
01818
01819 ######################################################################
01820 # Returns the range of the first child within the given parent range.
01821 proc bracket_first_child {txtt type startpos endpos} {
01822
01823 if {[$txtt is $type left $startpos]} {
01824 if {[set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos]] ne ""} {
01825 if {[$txtt compare $right == $endpos-1c]} {
01826 return [list [$txtt index $startpos+1c] $right]
01827 } elseif {[$txtt compare $right < $endpos]} {
01828 return [list $startpos [$txtt index $right+1c]]
01829 }
01830 }
01831 } elseif {[set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $startpos]] ne ""} {
01832 if {[set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $left]] ne ""} {
01833 if {[$txtt compare $right < $endpos]} {
01834 return [list $left [$txtt index $right+1c]]
01835 }
01836 }
01837 }
01838
01839 return ""
01840
01841 }
01842
01843 ######################################################################
01844 # Returns the range of the last child within the given parent range.
01845 proc bracket_last_child {txtt type startpos endpos} {
01846
01847 if {[$txtt is $type right $endpos-1c]} {
01848 if {[set left [ctext::getMatchBracket [winfo parent $txtt] ${type}L $endpos-1c]] ne ""} {
01849 if {[$txtt compare $left == $startpos]} {
01850 return [list [$txtt index $startpos+1c] [$txtt index $endpos-1c]]
01851 } elseif {[$txtt compare $startpos < $left]} {
01852 return [list $left $endpos]
01853 }
01854 }
01855 } elseif {[set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $endpos]] ne ""} {
01856 if {[set left [ctext::getMatchBracket [winfo parent $txtt] ${type}L $right]] ne ""} {
01857 if {[$txtt compare $startpos < $left]} {
01858 return [list $left [$txtt index $right+1c]]
01859 }
01860 }
01861 }
01862
01863 return ""
01864
01865 }
01866
01867 ######################################################################
01868 # Return the range of the next sibling bracket type.
01869 proc bracket_next_sibling {txtt type startpos endpos} {
01870
01871 variable data
01872
01873 if {[$txtt is $type left $startpos]} {
01874 set parent [bracket_parent $txtt $type $startpos $endpos]
01875 if {$data($txtt,anchorend) == 0} {
01876 set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $endpos]
01877 } else {
01878 set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $startpos]
01879 }
01880 if {($left ne "") && ([lindex $parent 1] ne "") && [$txtt compare $left < [lindex $parent 1]]} {
01881 return [list $left [ctext::getMatchBracket [winfo parent $txtt] ${type}R $left]+1c]
01882 }
01883 }
01884
01885 return ""
01886
01887 }
01888
01889 ######################################################################
01890 # Return the range of the previous sibling bracket type.
01891 proc bracket_prev_sibling {txtt type startpos endpos} {
01892
01893 variable data
01894
01895 if {[$txtt is $type left $startpos]} {
01896 set parent [bracket_parent $txtt $type $startpos $endpos]
01897 if {$data($txtt,anchorend) == 0} {
01898 set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $endpos-1c]
01899 } else {
01900 set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $startpos]
01901 }
01902 if {($right ne "") && ([lindex $parent 0] ne "") && [$txtt compare [lindex $parent 0] < $right]} {
01903 return [list [ctext::getMatchBracket [winfo parent $txtt] ${type}L $right] $right+1c]
01904 }
01905 }
01906
01907 return ""
01908
01909 }
01910
01911 ######################################################################
01912 # Quickly selects the given type of text for the current editing buffer.
01913 # This functionality is meant to allow us to provide similar functionality
01914 # to other editors via the menus.
01915 proc quick_select {type} {
01916
01917 variable data
01918
01919 set txtt [gui::current_txt].t
01920
01921 # Make sure that we lose our current selection
01922 $txtt tag remove sel 1.0 end
01923
01924 # If the type is brackets, figure out the closest bracket to the insertion cursor. If we
01925 # are not detected to be within a bracket, return without doing anything
01926 if {($type eq "bracket") && ([set type [get_bracket_type $txtt [$txtt index insert]]] eq "")} {
01927 return
01928 }
01929
01930 # Set the type
01931 set data($txtt,type) $type
01932
01933 # Perform the selection
01934 update_selection $txtt init -startpos insert
01935
01936 }
01937
01938 ######################################################################
01939 # Quickly adds the line above/below the currently selected line to the
01940 # selection. This meant to provide backward compatibility with other
01941 # editors via the menus.
01942 proc quick_add_line {dir} {
01943
01944 variable data
01945
01946 # Get the current editing buffer
01947 set txtt [gui::current_txt].t
01948
01949 # Set the current selection type to line
01950 set data($txtt,type) "line"
01951 set data($txtt,anchorend) [expr {($dir eq "next") ? 0 : 1}]
01952
01953 # Add the given line
01954 update_selection $txtt $dir -startpos insert
01955
01956 }
01957
01958 }
