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 }