TKE  3.6
Advanced code editor for programmers
select Namespace Reference

Functions

 add txt frame
 
 undo txtt
 
 show_help txtt
 
 hide_help
 
 create_list w items ?txtt?
 
 set_type txtt value ?init?
 
 get_type txtt
 
 update_selection txtt motion args
 
 clear_selection txtt
 
 in_select_mode txtt ptype
 
 set_select_mode txtt value
 
 handle_selection txtt
 
 handle_focusout txtt
 
 handle_return txtt
 
 handle_escape txtt
 
 handle_backspace txtt
 
 handle_delete txtt
 
 handle_asciitilde txtt
 
 handle_slash txtt
 
 handle_single_press txtt x y
 
 handle_single_release txtt x y
 
 handle_double_click txtt x y
 
 handle_control_double_click txtt x y
 
 get_bracket_type txtt startpos
 
 handle_shift_control_double_click txtt x y
 
 handle_triple_click txtt x y
 
 handle_control_triple_click txtt x y
 
 handle_shift_control_triple_click txtt x y
 
 handle_block_selection txtt anchor current
 
 handle_alt_motion txtt x y
 
 handle_any txtt keysym
 
 handle_c txtt
 
 handle_e txtt
 
 handle_E txtt
 
 handle_b txtt
 
 handle_w txtt
 
 handle_s txtt
 
 handle_p txtt
 
 handle_n txtt
 
 handle_braceleft txtt
 
 handle_parenleft txtt
 
 handle_less txtt
 
 handle_bracketleft txtt
 
 handle_quotedbl txtt
 
 handle_quoteright txtt
 
 handle_quoteleft txtt
 
 handle_numbersign txtt
 
 handle_asterisk txtt
 
 handle_period txtt
 
 handle_H txtt
 
 handle_L txtt
 
 handle_K txtt
 
 handle_J txtt
 
 handle_h txtt
 
 handle_l txtt
 
 handle_k txtt
 
 handle_j txtt
 
 handle_a txtt
 
 handle_i txtt
 
 handle_u txtt
 
 handle_question txtt
 
 press txtt tag
 
 release txtt
 
 handle_enter txtt tag
 
 handle_leave txtt tag
 
 node_current txt startpos
 
 node_parent txt startpos endpos
 
 node_first_child txt startpos
 
 node_last_child txt startpos
 
 node_next_sibling txt startpos
 
 node_prev_sibling txt startpos
 
 bracket_current txtt type startpos
 
 bracket_parent txtt type startpos endpos
 
 bracket_first_child txtt type startpos endpos
 
 bracket_last_child txtt type startpos endpos
 
 bracket_next_sibling txtt type startpos endpos
 
 bracket_prev_sibling txtt type startpos endpos
 
 quick_select type
 
 quick_add_line dir
 

Function Documentation

§ add()

select::add   txt frame  

Definition at line 72 of file select.tcl.

72  proc add {txt frame} {
73 
74  variable data
75 
76  set data($txt.t,mode) 0
77  set data($txt.t,type) none
78  set data($txt.t,anchor) 1.0
79  set data($txt.t,anchorend) 0
80  set data($txt.t,dont_close) 0
81  set data($txt.t,inner) 1
82  set data($txt.t,number) ""
83  set data($txt.t,undo) [list]
84 
85  set alt [expr {([tk windowingsystem] eq "aqua") ? "Mod2" : "Alt"}]
86 
87  bind select <<Selection>> [list select::handle_selection %W]
88  bind select <FocusOut> [list select::handle_focusout %W]
89  bind select <Key> "if {\[select::handle_any %W %K\]} break"
90  bind select <Return> "if {\[select::handle_return %W\]} break"
91  bind select <Escape> "if {\[select::handle_escape %W\]} break"
92  bind select <BackSpace> "if {\[select::handle_backspace %W\]} break"
93  bind select <Delete> "if {\[select::handle_delete %W\]} break"
94  bind select <Double-Button-1> "if {\[select::handle_double_click %W %x %y\]} break"
95  bind select <Triple-Button-1> "if {\[select::handle_triple_click %W %x %y\]} break"
96  bind select <$alt-ButtonPress-1> "if {\[select::handle_single_press %W %x %y\]} break"
97  bind select <$alt-ButtonRelease-1> "if {\[select::handle_single_release %W %x %y\]} break"
98  bind select <$alt-B1-Motion> "if {\[select::handle_alt_motion %W %x %y\]} break"
99  bind select <Control-Double-Button-1> "if {\[select::handle_control_double_click %W %x %y\]} break"
100  bind select <Control-Triple-Button-1> "if {\[select::handle_control_triple_click %W %x %y\]} break"
101  bind select <Shift-Control-Double-Button-1> "if {\[select::handle_shift_control_double_click %W %x %y\]} break"
102  bind select <Shift-Control-Triple-Button-1> "if {\[select::handle_shift_control_triple_click %W %x %y\]} break"
103 
104  bindtags $txt.t [linsert [bindtags $txt.t] [expr [lsearch [bindtags $txt.t] $txt.t] + 1] select]
105 
106  }}

§ bracket_current()

select::bracket_current   txtt type startpos  

Definition at line 1784 of file select.tcl.

1784  proc bracket_current {txtt type startpos} {
1785 
1786  if {[$txtt is $type $startpos]} {
1787  return [edit::get_range $txtt [list $type 1] [list] o 0 $startpos]
1788  } else {
1789  return [edit::get_range $txtt [list $type 1] [list] i 0 $startpos]
1790  }
1791 
1792  }}

§ bracket_first_child()

select::bracket_first_child   txtt type startpos endpos  

Definition at line 1821 of file select.tcl.

1821  proc bracket_first_child {txtt type startpos endpos} {
1822 
1823  if {[$txtt is $type left $startpos]} {
1824  if {[set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos]] ne ""} {
1825  if {[$txtt compare $right == $endpos-1c]} {
1826  return [list [$txtt index $startpos+1c] $right]
1827  } elseif {[$txtt compare $right < $endpos]} {
1828  return [list $startpos [$txtt index $right+1c]]
1829  }
1830  }
1831  } elseif {[set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $startpos]] ne ""} {
1832  if {[set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $left]] ne ""} {
1833  if {[$txtt compare $right < $endpos]} {
1834  return [list $left [$txtt index $right+1c]]
1835  }
1836  }
1837  }
1838 
1839  return ""
1840 
1841  }}

§ bracket_last_child()

select::bracket_last_child   txtt type startpos endpos  

Definition at line 1845 of file select.tcl.

1845  proc bracket_last_child {txtt type startpos endpos} {
1846 
1847  if {[$txtt is $type right $endpos-1c]} {
1848  if {[set left [ctext::getMatchBracket [winfo parent $txtt] ${type}L $endpos-1c]] ne ""} {
1849  if {[$txtt compare $left == $startpos]} {
1850  return [list [$txtt index $startpos+1c] [$txtt index $endpos-1c]]
1851  } elseif {[$txtt compare $startpos < $left]} {
1852  return [list $left $endpos]
1853  }
1854  }
1855  } elseif {[set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $endpos]] ne ""} {
1856  if {[set left [ctext::getMatchBracket [winfo parent $txtt] ${type}L $right]] ne ""} {
1857  if {[$txtt compare $startpos < $left]} {
1858  return [list $left [$txtt index $right+1c]]
1859  }
1860  }
1861  }
1862 
1863  return ""
1864 
1865  }}

§ bracket_next_sibling()

select::bracket_next_sibling   txtt type startpos endpos  

Definition at line 1869 of file select.tcl.

1869  proc bracket_next_sibling {txtt type startpos endpos} {
1870 
1871  variable data
1872 
1873  if {[$txtt is $type left $startpos]} {
1874  set parent [bracket_parent $txtt $type $startpos $endpos]
1875  if {$data($txtt,anchorend) == 0} {
1876  set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $endpos]
1877  } else {
1878  set left [ctext::getNextBracket [winfo parent $txtt] ${type}L $startpos]
1879  }
1880  if {($left ne "") && ([lindex $parent 1] ne "") && [$txtt compare $left < [lindex $parent 1]]} {
1881  return [list $left [ctext::getMatchBracket [winfo parent $txtt] ${type}R $left]+1c]
1882  }
1883  }
1884 
1885  return ""
1886 
1887  }}

§ bracket_parent()

select::bracket_parent   txtt type startpos endpos  

Definition at line 1796 of file select.tcl.

1796  proc bracket_parent {txtt type startpos endpos} {
1797 
1798  if {[$txtt is $type left $startpos]} {
1799  set right [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos]
1800  if {[$txtt compare $right == $endpos-1c]} {
1801  if {[$txtt is $type left $startpos-1c]} {
1802  return [list $startpos [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos-1c]]
1803  } else {
1804  return [edit::get_range $txtt [list $type 1] [list] i 0 "$startpos-1c"]
1805  }
1806  } elseif {[$txtt is $type left $startpos-1c]} {
1807  return [list [$txtt index $startpos-1c] [ctext::getMatchBracket [winfo parent $txtt] ${type}R $startpos-1c]+1c]
1808  }
1809  }
1810 
1811  if {[set trange [edit::get_range $txtt [list $type 1] [list] o 0 "$startpos-1c"]] eq [list "" ""]} {
1812  return ""
1813  }
1814 
1815  return $trange
1816 
1817  }}

§ bracket_prev_sibling()

select::bracket_prev_sibling   txtt type startpos endpos  

Definition at line 1891 of file select.tcl.

1891  proc bracket_prev_sibling {txtt type startpos endpos} {
1892 
1893  variable data
1894 
1895  if {[$txtt is $type left $startpos]} {
1896  set parent [bracket_parent $txtt $type $startpos $endpos]
1897  if {$data($txtt,anchorend) == 0} {
1898  set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $endpos-1c]
1899  } else {
1900  set right [ctext::getPrevBracket [winfo parent $txtt] ${type}R $startpos]
1901  }
1902  if {($right ne "") && ([lindex $parent 0] ne "") && [$txtt compare [lindex $parent 0] < $right]} {
1903  return [list [ctext::getMatchBracket [winfo parent $txtt] ${type}L $right] $right+1c]
1904  }
1905  }
1906 
1907  return ""
1908 
1909  }}

§ clear_selection()

select::clear_selection   txtt  

Definition at line 710 of file select.tcl.

710  proc clear_selection {txtt} {
711 
712  variable data
713 
714  # Indicate to handle_selection that we don't want to exit selection mode
715  set data($txtt,dont_close) 1
716 
717  # Clear the selection
718  $txtt tag remove sel 1.0 end
719 
720  }}

§ create_list()

select::create_list   w items ?txtt?  

Definition at line 259 of file select.tcl.

259  proc create_list {w items {txtt ""}} {
260 
261  variable data
262 
263  set i 0
264 
265  foreach item $items {
266  lassign $item lbl shortcut type
267  if {$type ne ""} {
268  grid [ttk::label $w.c$i -text [expr {($data($txtt,type) eq $type) ? "\u2713" : " "}]] -row $i -column 0 -sticky news -padx 2 -pady 2
269  }
270  grid [ttk::label $w.s$i -text $shortcut -anchor e -width 3] -row $i -column 1 -sticky news -padx 4 -pady 2
271  grid [ttk::label $w.l$i -text $lbl -anchor w -width 20] -row $i -column 2 -sticky news -padx 2 -pady 2
272  incr i
273  }
274 
275  }}

§ get_bracket_type()

select::get_bracket_type   txtt startpos  

Definition at line 1038 of file select.tcl.

1038  proc get_bracket_type {txtt startpos} {
1039 
1040  set type ""
1041 
1042  # If we are within a comment, return
1043  if {[$txtt is incomment $startpos]} {
1044  return comment
1045  } elseif {[$txtt is instring $startpos]} {
1046  if {[$txtt is insingle $startpos]} {
1047  set type single
1048  } elseif {[$txtt is indouble $startpos]} {
1049  set type double
1050  } else {
1051  set type btick
1052  }
1053  } else {
1054  set closest ""
1055  foreach t [list square curly paren angled] {
1056  if {[$txtt is $t $startpos]} {
1057  set type $t
1058  break
1059  } elseif {[set index [ctext::getMatchBracket [winfo parent $txtt] ${t}L $startpos]] ne ""} {
1060  if {($closest eq "") || [$txtt compare $index > $closest]} {
1061  set type $t
1062  set closest $index
1063  }
1064  }
1065  }
1066  }
1067 
1068  return $type
1069 
1070  }}

§ get_type()

select::get_type   txtt  

Definition at line 300 of file select.tcl.

300  proc get_type {txtt} {
301 
302  variable data
303 
304  if {[info exists data($txtt,type)]} {
305  return $data($txtt,type)
306  }
307 
308  return "none"
309 
310  }}

§ handle_a()

select::handle_a   txtt  

Definition at line 1542 of file select.tcl.

1542  proc handle_a {txtt} {
1543 
1544  variable data
1545 
1546  # Get the selected ranges (if none is set, return immediately)
1547  if {[set sel [$txtt tag ranges sel]] eq ""} {
1548  return
1549  }
1550 
1551  # Change the anchor end
1552  set data($txtt,anchorend) [expr $data($txtt,anchorend) ^ 1]
1553 
1554  # Set the anchor
1555  if {$data($txtt,anchorend)} {
1556  set data($txtt,anchor) [lindex $sel end]
1557  set cursor [lindex $sel 0]
1558  } else {
1559  set data($txtt,anchor) [lindex $sel 0]
1560  set cursor [lindex $sel end]
1561  }
1562 
1563  # Move the insertion cursor to the new anchor position
1564  $txtt mark set insert $cursor
1565  $txtt see $cursor
1566 
1567  }}

§ handle_alt_motion()

select::handle_alt_motion   txtt x y  

Definition at line 1172 of file select.tcl.

1172  proc handle_alt_motion {txtt x y} {
1173 
1174  variable data
1175 
1176  handle_block_selection $txtt $data($txtt,anchor) [$txtt index @$x,$y]
1177 
1178  return 1
1179 
1180  }}

§ handle_any()

select::handle_any   txtt keysym  

Definition at line 1184 of file select.tcl.

1184  proc handle_any {txtt keysym} {
1185 
1186  variable data
1187 
1188  if {$data($txtt,mode) == 0} {
1189  return 0
1190  }
1191 
1192  # Check to see if the selection window exists
1193  set help_existed [winfo exists .selhelp]
1194 
1195  # If the keysym is a number, append the number to the current one.
1196  if {[string is integer $keysym]} {
1197  if {($keysym ne "0") || ($data($txtt,number) ne "")} {
1198  append data($txtt,number) $keysym
1199  }
1200 
1201  # Handle the specified key, if a handler exists for it
1202  } elseif {[info procs handle_$keysym] ne ""} {
1203  handle_$keysym $txtt
1204  }
1205 
1206  # Hide the help window if it is displayed
1207  if {$help_existed} {
1208  hide_help
1209  }
1210 
1211  return 1
1212 
1213  }}

§ handle_asciitilde()

select::handle_asciitilde   txtt  

Definition at line 922 of file select.tcl.

922  proc handle_asciitilde {txtt} {
923 
924  variable data
925 
926  if {$data($txtt,mode) == 0} {
927  return 0
928  }
929 
930  # Get the current selection
931  set ranges [$txtt tag ranges sel]
932 
933  # Select everything and remove the given ranges
934  $txtt tag add sel 1.0 end
935  $txtt tag remove sel {*}$ranges
936 
937  # Disable selection mode
938  set_select_mode $txtt 0
939  set data($txtt,type) "none"
940 
941  # Hide the help window
942  hide_help
943 
944  return 1
945 
946  }}

§ handle_asterisk()

select::handle_asterisk   txtt  

Definition at line 1346 of file select.tcl.

1346  proc handle_asterisk {txtt} {
1347 
1348  set_type $txtt all
1349 
1350  }}

§ handle_b()

select::handle_b   txtt  

Definition at line 1242 of file select.tcl.

1242  proc handle_b {txtt} {
1243 
1244  set_type $txtt block
1245 
1246  }}

§ handle_backspace()

select::handle_backspace   txtt  

Definition at line 869 of file select.tcl.

869  proc handle_backspace {txtt} {
870 
871  variable data
872 
873  if {$data($txtt,mode) == 0} {
874  return 0
875  }
876 
877  # Delete the text
878  if {![multicursor::delete $txtt [list char -dir prev] ""]} {
879  edit::delete $txtt {*}[lrange [$txtt tag ranges sel] 0 1] 1 1
880  }
881 
882  # Disable selection mode
883  set_select_mode $txtt 0
884  set data($txtt,type) "none"
885 
886  # Hide the help window
887  hide_help
888 
889  return 1
890 
891  }}

§ handle_block_selection()

select::handle_block_selection   txtt anchor current  

Definition at line 1136 of file select.tcl.

1136  proc handle_block_selection {txtt anchor current} {
1137 
1138  # Get the anchor and current row/col, but if either is invalid, return immediately
1139  if {[set acol [lassign [split $anchor .] arow]] eq ""} {
1140  return
1141  }
1142  if {[set ccol [lassign [split $current .] crow]] eq ""} {
1143  return
1144  }
1145 
1146  if {$arow < $crow} {
1147  set srow $arow
1148  set erow $crow
1149  } else {
1150  set srow $crow
1151  set erow $arow
1152  }
1153 
1154  if {$acol < $ccol} {
1155  set scol $acol
1156  set ecol $ccol
1157  } else {
1158  set scol $ccol
1159  set ecol $acol
1160  }
1161 
1162  # Set the selection
1163  clear_selection $txtt
1164  for {set i $srow} {$i <= $erow} {incr i} {
1165  $txtt tag add sel $i.$scol $i.$ecol
1166  }
1167 
1168  }}

§ handle_braceleft()

select::handle_braceleft   txtt  

Definition at line 1282 of file select.tcl.

1282  proc handle_braceleft {txtt} {
1283 
1284  set_type $txtt curly
1285 
1286  }}

§ handle_bracketleft()

select::handle_bracketleft   txtt  

Definition at line 1306 of file select.tcl.

1306  proc handle_bracketleft {txtt} {
1307 
1308  set_type $txtt square
1309 
1310  }}

§ handle_c()

select::handle_c   txtt  

Definition at line 1217 of file select.tcl.

1217  proc handle_c {txtt} {
1218 
1219  # Make sure that char is selected
1220  set_type $txtt char
1221 
1222  }}

§ handle_control_double_click()

select::handle_control_double_click   txtt x y  

Definition at line 1024 of file select.tcl.

1024  proc handle_control_double_click {txtt x y} {
1025 
1026  # Set the selection type to sentence
1027  set_type $txtt sentence
1028 
1029  # Update the selection
1030  update_selection $txtt init -startpos [$txtt index @$x,$y]
1031 
1032  return 1
1033 
1034  }}

§ handle_control_triple_click()

select::handle_control_triple_click   txtt x y  

Definition at line 1107 of file select.tcl.

1107  proc handle_control_triple_click {txtt x y} {
1108 
1109  # Set the selection type to paragraph
1110  set_type $txtt paragraph
1111 
1112  # Update the selection
1113  update_selection $txtt init -startpos [$txtt index @$x,$y]
1114 
1115  return 1
1116 
1117  }}

§ handle_delete()

select::handle_delete   txtt  

Definition at line 896 of file select.tcl.

896  proc handle_delete {txtt} {
897 
898  variable data
899 
900  if {$data($txtt,mode) == 0} {
901  return 0
902  }
903 
904  # Delete the text
905  if {![multicursor::delete $txtt [list char -dir next] ""]} {
906  edit::delete $txtt {*}[lrange [$txtt tag ranges sel] 0 1] 1 1
907  }
908 
909  # Disable selection mode
910  set_select_mode $txtt 0
911  set data($txtt,type) "none"
912 
913  # Hide the help window
914  hide_help
915 
916  return 1
917 
918  }}

§ handle_double_click()

select::handle_double_click   txtt x y  

Definition at line 1012 of file select.tcl.

1012  proc handle_double_click {txtt x y} {
1013 
1014  # Set the selection type to inner word
1015  set_type $txtt word
1016 
1017  return 0
1018 
1019  }}

§ handle_e()

select::handle_e   txtt  

Definition at line 1226 of file select.tcl.

1226  proc handle_e {txtt} {
1227 
1228  set_type $txtt line
1229 
1230  }}

§ handle_E()

select::handle_E   txtt  

Definition at line 1234 of file select.tcl.

1234  proc handle_E {txtt} {
1235 
1236  set_type $txtt lineto
1237 
1238  }}

§ handle_enter()

select::handle_enter   txtt tag  

Definition at line 1622 of file select.tcl.

1622  proc handle_enter {txtt tag} {
1623 
1624  # Get the base color of the selection
1625  set color [$txtt tag cget sel -background]
1626 
1627  # Set the color of the start/end tag to an adjusted color from the selection color
1628  $txtt tag configure $tag -background [utils::auto_adjust_color $color 40]
1629 
1630  }}

§ handle_escape()

select::handle_escape   txtt  

Definition at line 846 of file select.tcl.

846  proc handle_escape {txtt} {
847 
848  variable data
849 
850  if {$data($txtt,mode) == 0} {
851  return 0
852  }
853 
854  # This is only necessary for BIST testing on MacOS, but it should not hurt
855  # anything to clear the type anyways
856  set data($txtt,type) "none"
857  set_select_mode $txtt 0
858 
859  # Clear the selection
860  $txtt tag remove sel 1.0 end
861 
862  return 1
863 
864  }}

§ handle_focusout()

select::handle_focusout   txtt  

Definition at line 812 of file select.tcl.

812  proc handle_focusout {txtt} {
813 
814  # Hide the help window if we lose focus
815  hide_help
816 
817  }}

§ handle_H()

select::handle_H   txtt  

Definition at line 1362 of file select.tcl.

1362  proc handle_H {txtt} {
1363 
1364  variable data
1365 
1366  switch $data($txtt,type) {
1367  all -
1368  allto -
1369  line -
1370  lineto -
1371  single -
1372  double -
1373  btick -
1374  comment {}
1375  node -
1376  curly -
1377  square -
1378  paren -
1379  angled { update_selection $txtt parent}
1380  default { update_selection $txtt lshift}
1381  }}
1382 
1383  }}

§ handle_h()

select::handle_h   txtt  

Definition at line 1454 of file select.tcl.

1454  proc handle_h {txtt} {
1455 
1456  variable data
1457 
1458  switch $data($txtt,type) {
1459  node -
1460  square -
1461  curly -
1462  paren -
1463  angled { update_selection $txtt parent}
1464  block { update_selection $txtt left}
1465  char -
1466  line -
1467  lineto -
1468  word -
1469  sentence -
1470  paragraph { update_selection $txtt prev}
1471  }}
1472 
1473  }}

§ handle_i()

select::handle_i   txtt  

Definition at line 1573 of file select.tcl.

1573  proc handle_i {txtt} {
1574 
1575  variable data
1576 
1577  if {[lsearch [list single double btick comment] $data($txtt,type)] != -1} {
1578  set data($txtt,inner) [expr {$data($txtt,inner) ^ 1}]
1579  update_selection $txtt init
1580  }
1581 
1582  }}

§ handle_J()

select::handle_J   txtt  

Definition at line 1434 of file select.tcl.

1434  proc handle_J {txtt} {
1435 
1436  variable data
1437 
1438  switch $data($txtt,type) {
1439  char -
1440  block -
1441  node -
1442  line -
1443  lineto -
1444  curly -
1445  square -
1446  paren -
1447  angled { update_selection $txtt dshift}
1448  }}
1449 
1450  }}

§ handle_j()

select::handle_j   txtt  

Definition at line 1522 of file select.tcl.

1522  proc handle_j {txtt} {
1523 
1524  variable data
1525 
1526  switch $data($txtt,type) {
1527  char -
1528  block { update_selection $txtt down}
1529  node -
1530  line -
1531  lineto -
1532  curly -
1533  square -
1534  paren -
1535  angled { update_selection $txtt next}
1536  }}
1537 
1538  }}

§ handle_K()

select::handle_K   txtt  

Definition at line 1413 of file select.tcl.

1413  proc handle_K {txtt} {
1414 
1415  variable data
1416 
1417  switch $data($txtt,type) {
1418  char -
1419  block -
1420  node -
1421  line -
1422  lineto -
1423  curly -
1424  square -
1425  paren -
1426  angled { update_selection $txtt ushift}
1427  }}
1428 
1429  }}

§ handle_k()

select::handle_k   txtt  

Definition at line 1501 of file select.tcl.

1501  proc handle_k {txtt} {
1502 
1503  variable data
1504 
1505  switch $data($txtt,type) {
1506  char -
1507  block { update_selection $txtt up}
1508  node -
1509  line -
1510  lineto -
1511  curly -
1512  square -
1513  paren -
1514  angled { update_selection $txtt prev}
1515  }}
1516 
1517  }}

§ handle_L()

select::handle_L   txtt  

Definition at line 1387 of file select.tcl.

1387  proc handle_L {txtt} {
1388 
1389  variable data
1390 
1391  switch $data($txtt,type) {
1392  all -
1393  allto -
1394  line -
1395  lineto -
1396  single -
1397  double -
1398  btick -
1399  comment {}
1400  node -
1401  curly -
1402  square -
1403  paren -
1404  angled { update_selection $txtt child}
1405  default { update_selection $txtt rshift}
1406  }}
1407 
1408  }}

§ handle_l()

select::handle_l   txtt  

Definition at line 1477 of file select.tcl.

1477  proc handle_l {txtt} {
1478 
1479  variable data
1480 
1481  switch $data($txtt,type) {
1482  node -
1483  curly -
1484  square -
1485  paren -
1486  angled { update_selection $txtt child}
1487  block { update_selection $txtt right}
1488  char -
1489  line -
1490  lineto -
1491  word -
1492  sentence -
1493  paragraph { update_selection $txtt next}
1494  }}
1495 
1496  }}

§ handle_leave()

select::handle_leave   txtt tag  

Definition at line 1634 of file select.tcl.

1634  proc handle_leave {txtt tag} {
1635 
1636  # Remove the background color of the tag
1637  $txtt tag configure $tag -background ""
1638 
1639  }}

§ handle_less()

select::handle_less   txtt  

Definition at line 1298 of file select.tcl.

1298  proc handle_less {txtt} {
1299 
1300  set_type $txtt angled
1301 
1302  }}

§ handle_n()

select::handle_n   txtt  

Definition at line 1274 of file select.tcl.

1274  proc handle_n {txtt} {
1275 
1276  set_type $txtt node
1277 
1278  }}

§ handle_numbersign()

select::handle_numbersign   txtt  

Definition at line 1338 of file select.tcl.

1338  proc handle_numbersign {txtt} {
1339 
1340  set_type $txtt comment
1341 
1342  }}

§ handle_p()

select::handle_p   txtt  

Definition at line 1266 of file select.tcl.

1266  proc handle_p {txtt} {
1267 
1268  set_type $txtt paragraph
1269 
1270  }}

§ handle_parenleft()

select::handle_parenleft   txtt  

Definition at line 1290 of file select.tcl.

1290  proc handle_parenleft {txtt} {
1291 
1292  set_type $txtt paren
1293 
1294  }}

§ handle_period()

select::handle_period   txtt  

Definition at line 1354 of file select.tcl.

1354  proc handle_period {txtt} {
1355 
1356  set_type $txtt allto
1357 
1358  }}

§ handle_question()

select::handle_question   txtt  

Definition at line 1594 of file select.tcl.

1594  proc handle_question {txtt} {
1595 
1596  show_help $txtt
1597 
1598  }}

§ handle_quotedbl()

select::handle_quotedbl   txtt  

Definition at line 1314 of file select.tcl.

1314  proc handle_quotedbl {txtt} {
1315 
1316  set_type $txtt double
1317 
1318  }}

§ handle_quoteleft()

select::handle_quoteleft   txtt  

Definition at line 1330 of file select.tcl.

1330  proc handle_quoteleft {txtt} {
1331 
1332  set_type $txtt btick
1333 
1334  }}

§ handle_quoteright()

select::handle_quoteright   txtt  

Definition at line 1322 of file select.tcl.

1322  proc handle_quoteright {txtt} {
1323 
1324  set_type $txtt single
1325 
1326  }}

§ handle_return()

select::handle_return   txtt  

Definition at line 822 of file select.tcl.

822  proc handle_return {txtt} {
823 
824  variable data
825 
826  if {$data($txtt,mode) == 0} {
827  return 0
828  }
829 
830  # Disable selection mode
831  set_select_mode $txtt 0
832 
833  # Allow Vim to remember this selection
835 
836  # Hide the help window if it is displayed
837  hide_help
838 
839  return 1
840 
841  }}

§ handle_s()

select::handle_s   txtt  

Definition at line 1258 of file select.tcl.

1258  proc handle_s {txtt} {
1259 
1260  set_type $txtt sentence
1261 
1262  }}

§ handle_selection()

select::handle_selection   txtt  

Definition at line 793 of file select.tcl.

793  proc handle_selection {txtt} {
794 
795  variable data
796 
797  if {([$txtt tag ranges sel] eq "") && !$data($txtt,dont_close)} {
798  set_select_mode $txtt 0
799  set data($txtt,type) "none"
800  }
801 
802  # Clear the dont_close indicator
803  set data($txtt,dont_close) 0
804 
805  # Hide the help display if it is in view
806  hide_help
807 
808  }}

§ handle_shift_control_double_click()

select::handle_shift_control_double_click   txtt x y  

Definition at line 1075 of file select.tcl.

1075  proc handle_shift_control_double_click {txtt x y} {
1076 
1077  # Get the bracket type closest to the mouse cursor
1078  if {[set type [get_bracket_type $txtt [$txtt index @$x,$y]]] ne ""} {
1079 
1080  # Set the type
1081  set_type $txtt $type
1082 
1083  # Update the selection
1084  update_selection $txtt init -startpos [$txtt index @$x,$y]
1085 
1086  }
1087 
1088  return 1
1089 
1090  }}

§ handle_shift_control_triple_click()

select::handle_shift_control_triple_click   txtt x y  

Definition at line 1122 of file select.tcl.

1122  proc handle_shift_control_triple_click {txtt x y} {
1123 
1124  # Set the selection type to node
1125  set_type $txtt node
1126 
1127  # Update the selection
1128  update_selection $txtt init -startpos [$txtt index @$x,$y]
1129 
1130  return 1
1131 
1132  }}

§ handle_single_press()

select::handle_single_press   txtt x y  

Definition at line 985 of file select.tcl.

985  proc handle_single_press {txtt x y} {
986 
987  variable data
988 
989  # Change the anchor end
990  set data($txtt,anchorend) 0
991 
992  # Set the anchor
993  set data($txtt,anchor) [$txtt index @$x,$y]
994 
995  # Set the insertion cursor
996  $txtt mark set insert $data($txtt,anchor)
997 
998  return 0
999 
1000  }}

§ handle_single_release()

select::handle_single_release   txtt x y  

Definition at line 1004 of file select.tcl.

1004  proc handle_single_release {txtt x y} {
1005 
1006  return 1
1007 
1008  }}

§ handle_slash()

select::handle_slash   txtt  

Definition at line 951 of file select.tcl.

951  proc handle_slash {txtt} {
952 
953  variable data
954 
955  if {$data($txtt,mode) == 0} {
956  return 0
957  }
958 
959  # Get the selection string to match against
960  set str [$txtt get sel.first sel.last]
961 
962  # Find all text in the editing buffer that matches the selected text
963  set i 0
964  foreach index [$txtt search -all -count lengths -forward -- $str 1.0 end] {
965  $txtt tag add sel $index "$index+[lindex $lengths $i]c"
966  incr i
967  }
968 
969  # Disable selection mode
970  set_select_mode $txtt 0
971  set data($txtt,type) "none"
972 
973  # Hide the help window
974  hide_help
975 
976  # Tell the user how many matches we found
977  gui::set_info_message [format "%s %d %s" [msgcat::mc "Selected"] [expr $i - 1] [msgcat::mc "matching instances"]]
978 
979  return 1
980 
981  }}

§ handle_triple_click()

select::handle_triple_click   txtt x y  

Definition at line 1095 of file select.tcl.

1095  proc handle_triple_click {txtt x y} {
1096 
1097  # Set the selection type to inner line
1098  set_type $txtt line
1099 
1100  return 0
1101 
1102  }}

§ handle_u()

select::handle_u   txtt  

Definition at line 1586 of file select.tcl.

1586  proc handle_u {txtt} {
1587 
1588  undo $txtt
1589 
1590  }}

§ handle_w()

select::handle_w   txtt  

Definition at line 1250 of file select.tcl.

1250  proc handle_w {txtt} {
1251 
1252  set_type $txtt word
1253 
1254  }}

§ hide_help()

select::hide_help

Definition at line 250 of file select.tcl.

250  proc hide_help {} {
251 
252  # Destroy the help window if it is displayed
253  catch { destroy .selhelp }
254 
255  }}

§ in_select_mode()

select::in_select_mode   txtt ptype  

Definition at line 725 of file select.tcl.

725  proc in_select_mode {txtt ptype} {
726 
727  upvar $ptype type
728 
729  variable data
730 
731  if {![info exists data($txtt,mode)]} {
732  return 0
733  }
734 
735  set type $data($txtt,type)
736 
737  return $data($txtt,mode)
738 
739  }}

§ node_current()

select::node_current   txt startpos  

Definition at line 1643 of file select.tcl.

1643  proc node_current {txt startpos} {
1644 
1645  if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
1646  return [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
1647  } elseif {[lindex $tag 3] eq "010"} {
1648  return [lrange $tag 0 1]
1649  } else {
1650  return [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
1651  }
1652  }}

§ node_first_child()

select::node_first_child   txt startpos  

Definition at line 1674 of file select.tcl.

1674  proc node_first_child {txt startpos} {
1675 
1676  set parent_range [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
1677 
1678  if {[emmet::inside_tag $txt -startpos $startpos -allow010 1] eq ""} {
1679  if {[set tag [emmet::get_tag $txt -dir next -type ??0 -start [lindex $parent_range 0]]] ne ""} {
1680  if {[$txt compare [lindex $tag 0] < [lindex $parent_range 1]]} {
1681  if {[lindex $tag 3] eq "010"} {
1682  return [lrange $tag 0 1]
1683  } else {
1684  return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
1685  }
1686  }
1687  }
1688  } elseif {($parent_range eq "") || [$txt compare [lindex $parent_range 0] == [lindex $parent_range 1]]} {
1689  return ""
1690  }
1691 
1692  return $parent_range
1693 
1694  }}

§ node_last_child()

select::node_last_child   txt startpos  

Definition at line 1700 of file select.tcl.

1700  proc node_last_child {txt startpos} {
1701 
1702  set parent_range [emmet::get_inner [emmet::get_node_range $txt -startpos $startpos]]
1703 
1704  if {[emmet::inside_tag $txt -startpos $startpos -allow010 1] eq ""} {
1705  if {[set tag [emmet::get_tag $txt -dir prev -type ??0 -start [lindex $parent_range 1]]] ne ""} {
1706  if {[$txt compare [lindex $tag 0] > [lindex $parent_range 0]]} {
1707  if {[lindex $tag 3] eq "010"} {
1708  return [lrange $tag 0 1]
1709  } else {
1710  return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
1711  }
1712  }
1713  }
1714  } elseif {($parent_range eq "") || [$txt compare [lindex $parent_range 0] == [lindex $parent_range 1]]} {
1715  return ""
1716  }
1717 
1718  return $parent_range
1719 
1720  }}

§ node_next_sibling()

select::node_next_sibling   txt startpos  

Definition at line 1725 of file select.tcl.

1725  proc node_next_sibling {txt startpos} {
1726 
1727  if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
1728  return ""
1729  }
1730 
1731  if {[lindex $tag 3] eq "010"} {
1732  set current_range [lrange $tag 0 1]
1733  } else {
1734  set current_range [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
1735  }
1736  set parent_range [node_parent $txt {*}$current_range]
1737 
1738  if {[set tag [emmet::get_tag $txt -dir next -type ??0 -start [lindex $current_range 1]]] ne ""} {
1739  if {($parent_range eq "") || [$txt compare [lindex $tag 0] < [lindex $parent_range 1]]} {
1740  if {[lindex $tag 3] eq "010"} {
1741  return [lrange $tag 0 1]
1742  } else {
1743  return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
1744  }
1745  }
1746  }
1747 
1748  return ""
1749 
1750  }}

§ node_parent()

select::node_parent   txt startpos endpos  

Definition at line 1657 of file select.tcl.

1657  proc node_parent {txt startpos endpos} {
1658 
1659  set within [emmet::get_node_range_within $txt -startpos $startpos]
1660 
1661  if {(([set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq "") && ([lindex $tag 3] ne "010")) || \
1662  ([emmet::get_inner $within] eq [list $startpos $endpos])} {
1663  return [emmet::get_outer $within]
1664  } else {
1665  return [emmet::get_inner $within]
1666  }
1667 
1668  }}

§ node_prev_sibling()

select::node_prev_sibling   txt startpos  

Definition at line 1755 of file select.tcl.

1755  proc node_prev_sibling {txt startpos} {
1756 
1757  if {[set tag [emmet::inside_tag $txt -startpos $startpos -allow010 1]] eq ""} {
1758  return ""
1759  }
1760 
1761  if {[lindex $tag 3] eq "010"} {
1762  set current_range [lrange $tag 0 1]
1763  } else {
1764  set current_range [emmet::get_outer [emmet::get_node_range $txt -startpos $startpos]]
1765  }
1766  set parent_range [node_parent $txt {*}$current_range]
1767 
1768  if {[set tag [emmet::get_tag $txt -dir prev -type 0?? -start "[lindex $current_range 0]-1c"]] ne ""} {
1769  if {($parent_range eq "") || [$txt compare [lindex $tag 0] > [lindex $parent_range 0]]} {
1770  if {[lindex $tag 3] eq "010"} {
1771  return [lrange $tag 0 1]
1772  } else {
1773  return [emmet::get_outer [emmet::get_node_range $txt -startpos [lindex $tag 0]]]
1774  }
1775  }
1776  }
1777 
1778  return ""
1779 
1780  }}

§ press()

select::press   txtt tag  

Definition at line 1602 of file select.tcl.

1602  proc press {txtt tag} {
1603 
1604  variable data
1605 
1606  set data($txtt,drag) $tag
1607 
1608  }}

§ quick_add_line()

select::quick_add_line   dir  

Definition at line 1942 of file select.tcl.

1942  proc quick_add_line {dir} {
1943 
1944  variable data
1945 
1946  # Get the current editing buffer
1947  set txtt [gui::current_txt].t
1948 
1949  # Set the current selection type to line
1950  set data($txtt,type) "line"
1951  set data($txtt,anchorend) [expr {($dir eq "next") ? 0 : 1}]
1952 
1953  # Add the given line
1954  update_selection $txtt $dir -startpos insert
1955 
1956  }}

§ quick_select()

select::quick_select   type  

Definition at line 1915 of file select.tcl.

1915  proc quick_select {type} {
1916 
1917  variable data
1918 
1919  set txtt [gui::current_txt].t
1920 
1921  # Make sure that we lose our current selection
1922  $txtt tag remove sel 1.0 end
1923 
1924  # If the type is brackets, figure out the closest bracket to the insertion cursor. If we
1925  # are not detected to be within a bracket, return without doing anything
1926  if {($type eq "bracket") && ([set type [get_bracket_type $txtt [$txtt index insert]]] eq "")} {
1927  return
1928  }
1929 
1930  # Set the type
1931  set data($txtt,type) $type
1932 
1933  # Perform the selection
1934  update_selection $txtt init -startpos insert
1935 
1936  }}

§ release()

select::release   txtt  

Definition at line 1612 of file select.tcl.

1612  proc release {txtt} {
1613 
1614  variable data
1615 
1616  unset -nocomplain data($txtt,drag)
1617 
1618  }}

§ set_select_mode()

select::set_select_mode   txtt value  

Definition at line 744 of file select.tcl.

744  proc set_select_mode {txtt value} {
745 
746  variable data
747 
748  # Set the mode
749  if {$data($txtt,mode) != $value} {
750 
751  # Set the mode to the given value
752  set data($txtt,mode) $value
753 
754  # If we are enabled, do some initializing
755  if {$value} {
756 
757  set data($txtt,anchor) [$txtt index insert]
758  set data($txtt,anchorend) 0
759  set data($txtt,undo) [list]
760 
761  # If text was not previously selected, select it by word
762  if {[set sel [$txtt tag ranges sel]] eq ""} {
763  set_type $txtt "word" 1
764  } elseif {$data($txtt,type) eq "none"} {
765  set_type $txtt "char" 0
766  }
767 
768  # Configure the cursor
769  $txtt configure -cursor [ttk::cursor standard]
770 
771  # Display a help message
772  gui::set_info_message [msgcat::mc "Type '?' for help. Hit the ESCAPE key to exit selection mode"] -win [winfo parent $txtt] -clear_delay 0
773 
774  # Otherwise, configure the cursor
775  } else {
776 
777  $txtt configure -cursor ""
778 
779  # Clear the help message
780  gui::set_info_message "" -win [winfo parent $txtt]
781 
782  }
783 
784  # Make sure that the information bar is updated appropriately
785  gui::update_position [winfo parent $txtt]
786 
787  }
788 
789  }}

§ set_type()

select::set_type   txtt value ?init?  

Definition at line 279 of file select.tcl.

279  proc set_type {txtt value {init 1}} {
280 
281  variable data
282 
283  # Set the type
284  set data($txtt,type) $value
285 
286  # Update the selection
287  if {$data($txtt,mode) && $init} {
288  update_selection $txtt init
289  }
290 
291  # Update the position
292  gui::update_position [winfo parent $txtt]
293 
294  }}

§ show_help()

select::show_help   txtt  

Definition at line 140 of file select.tcl.

140  proc show_help {txtt} {
141 
142  variable types
143  variable data
144 
145  if {[winfo exists .selhelp]} {
146  return
147  }
148 
149  # Create labels and their shortcuts
150  set left [list [msgcat::mc "Left"] "h"]
151  set right [list [msgcat::mc "Right"] "l"]
152  set up [list [msgcat::mc "Up"] "k"]
153  set down [list [msgcat::mc "Down"] "j"]
154  set lshift [list [msgcat::mc "Shift Left"] "H"]
155  set rshift [list [msgcat::mc "Shift Right"] "L"]
156  set ushift [list [msgcat::mc "Shift Up"] "K"]
157  set dshift [list [msgcat::mc "Shift Down"] "J"]
158  set next [list [msgcat::mc "Next"] "l"]
159  set prev [list [msgcat::mc "Previous"] "h"]
160  set parent [list [msgcat::mc "Parent"] "h"]
161  set child [list [msgcat::mc "Child"] "l"]
162  set nsib [list [msgcat::mc "Next Sibling"] "j"]
163  set psib [list [msgcat::mc "Previous Sibling"] "k"]
164  set swap [list [msgcat::mc "Swap Anchor"] "a"]
165  set undo [list [msgcat::mc "Undo Last Change"] "u"]
166  set help [list [msgcat::mc "Toggle Help"] "?"]
167  set ret [list [msgcat::mc "Keep Selection"] "\u21b5"]
168  set esc [list [msgcat::mc "Clear Selection"] "Esc"]
169  set del [list [msgcat::mc "Delete Selected Text"] "Del"]
170  set inv [list [msgcat::mc "Invert Selected Text"] "~"]
171  set find [list [msgcat::mc "Add Selection Matches"] "/"]
172  set inc [list [msgcat::mc "Toggle Quote Inclusion"] "i"]
173 
174  toplevel .selhelp
175  wm transient .selhelp .
176  wm overrideredirect .selhelp 1
177 
178  ttk::label .selhelp.title -text [msgcat::mc "Selection Mode Command Help"] -anchor center -padding 4
179  ttk::label .selhelp.close -image form_close -padding {8 0}
180  ttk::separator .selhelp.sep -orient horizontal
181  ttk::frame .selhelp.f
182 
183  bind .selhelp.close <Button-1> [list select::hide_help]
184 
185  ttk::labelframe .selhelp.f.types -text [msgcat::mc "Modes"]
186  create_list .selhelp.f.types $types $txtt
187 
188  ttk::labelframe .selhelp.f.motions -text [msgcat::mc "Motions"]
189  switch $data($txtt,type) {
190  char -
191  block {
192  create_list .selhelp.f.motions [list $left $right $up $down $lshift $rshift $ushift $dshift]
193  }
194  word -
195  sentence -
196  paragraph {
197  create_list .selhelp.f.motions [list $next $prev $lshift $rshift]
198  }
199  line -
200  lineto {
201  create_list .selhelp.f.motions [list $down $up $dshift $ushift]
202  }
203  node -
204  curly -
205  square -
206  paren -
207  angled {
208  create_list .selhelp.f.motions [list $parent $child $nsib $psib $dshift $ushift]
209  }
210  all -
211  allto -
212  default {
213  create_list .selhelp.f.motions [list $inc]
214  }
215  }}
216 
217  ttk::labelframe .selhelp.f.anchors -text [msgcat::mc "Anchor"]
218  create_list .selhelp.f.anchors [list $swap]
219 
220  ttk::labelframe .selhelp.f.help -text [msgcat::mc "Miscellaneous"]
221  create_list .selhelp.f.help [list $undo $help]
222 
223  ttk::labelframe .selhelp.f.exit -text [msgcat::mc "Exit Selection Mode"]
224  switch $data($txtt,type) {
225  block { create_list .selhelp.f.exit [list $ret $esc $del $inv]}
226  default { create_list .selhelp.f.exit [list $ret $esc $del $inv $find]}
227  }}
228 
229  # Pack the labelframes
230  grid .selhelp.f.types -row 0 -column 0 -sticky news -padx 2 -pady 2 -rowspan 4
231  grid .selhelp.f.motions -row 0 -column 1 -sticky news -padx 2 -pady 2
232  grid .selhelp.f.anchors -row 1 -column 1 -sticky news -padx 2 -pady 2
233  grid .selhelp.f.help -row 2 -column 1 -sticky news -padx 2 -pady 2
234  grid .selhelp.f.exit -row 3 -column 1 -sticky news -padx 2 -pady 2
235 
236  grid rowconfigure .selhelp 2 -weight 1
237  grid columnconfigure .selhelp 0 -weight 1
238  grid .selhelp.title -row 0 -column 0 -sticky ew
239  grid .selhelp.close -row 0 -column 1 -sticky news
240  grid .selhelp.sep -row 1 -column 0 -sticky ew -columnspan 2
241  grid .selhelp.f -row 2 -column 0 -sticky news -columnspan 2
242 
243  # Place the window in the middle of the main window
244  ::tk::PlaceWindow .selhelp widget .
245 
246  }}

§ undo()

select::undo   txtt  

Definition at line 110 of file select.tcl.

110  proc undo {txtt} {
111 
112  variable data
113 
114  if {[llength $data($txtt,undo)] > 1} {
115 
116  lassign [lindex $data($txtt,undo) end-1] type anchorend ranges
117 
118  # Set variables
119  set data($txtt,undo) [lrange $data($txtt,undo) 0 end-1]
120  set data($txtt,dont_close) 1
121  set data($txtt,type) $type
122  set data($txtt,anchorend) $anchorend
123 
124  # Calculate the insertion cursor index in the ranges list
125  set index [expr {$anchorend ? 0 : "end"}]
126 
127  # Clear the current selection and set the cursor
128  ::tk::TextSetCursor $txtt [lindex $ranges $index]
129 
130  # Add the selection
131  $txtt tag add sel {*}$ranges
132 
133  }
134 
135  }}

§ update_selection()

select::update_selection   txtt motion args  

Definition at line 316 of file select.tcl.

316  proc update_selection {txtt motion args} {
317 
318  variable data
319  variable positions
320 
321  array set opts {
322  -startpos ""
323  }
324  array set opts $args
325 
326  # Get the current selection ranges
327  set range [$txtt tag ranges sel]
328  set number [expr {($data($txtt,number) eq "") ? 1 : $data($txtt,number)}]
329  set data($txtt,number) ""
330 
331  switch $motion {
332  init {
333  if {$opts(-startpos) ne ""} {
334  $txtt mark set insert $opts(-startpos)
335  } elseif {[llength $range] == 0} {
336  $txtt mark set insert $data($txtt,anchor)
337  } elseif {$data($txtt,anchorend) == 0} {
338  $txtt mark set insert "insert-1 display chars"
339  }
340  switch $data($txtt,type) {
341  char -
342  block { set trange [list $data($txtt,anchor) "$data($txtt,anchor)+1 display chars"]}
343  line -
344  lineto {
345  set trange [edit::get_range $txtt linestart lineend "" 0]
346  if {$data($txtt,type) eq "lineto"} {
347  lset trange $data($txtt,anchorend) $data($txtt,anchor)
348  }
349  }
350  word {
351  if {[string is space [$txtt get insert]]} {
352  $txtt mark set insert [edit::get_index $txtt wordstart -dir [expr {($data($txtt,anchorend) == 0) ? "prev" : "next"}]]
353  }
354  set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] i 0]
355  }
356  sentence -
357  paragraph {
358  set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] o 0]
359  }
360  node { set trange [node_current [winfo parent $txtt] insert]}
361  all -
362  allto {
363  set trange [list 1.0 end]
364  if {$data($txtt,type) eq "allto"} {
365  lset trange $data($txtt,anchorend) [lindex $range $data($txtt,anchorend)]
366  }
367  }
368  comment {
369  if {[set ranges [ctext::commentCharRanges [winfo parent $txtt] insert]] ne ""} {
370  if {$data($txtt,inner)} {
371  set trange [lrange $ranges 1 2]
372  } else {
373  set trange [list [lindex $ranges 0] [lindex $ranges end]]
374  }
375  } else {
376  set trange $range
377  }
378  }
379  single -
380  double -
381  btick { set trange [edit::get_range $txtt [list $data($txtt,type) 1] [list] [expr {$data($txtt,inner) ? "i" : "o"}] 0]}
382  default { set trange [bracket_current $txtt $data($txtt,type) insert]}
383  }}
384  if {[lsearch [list char line lineto word sentence paragraph] $data($txtt,type)] != -1} {
385  if {$range eq ""} {
386  set range $trange
387  } else {
388  if {[$txtt compare [lindex $trange 0] < [lindex $range 0]]} {
389  lset range 0 [lindex $trange 0]
390  }
391  if {[$txtt compare [lindex $range 1] < [lindex $trange 1]]} {
392  lset range 1 [lindex $trange 1]
393  }
394  }
395  } else {
396  set range $trange
397  }
398  }
399  next -
400  prev {
401  set pos $positions($data($txtt,type))
402  set index [expr $data($txtt,anchorend) ^ 1]
403  switch $data($txtt,type) {
404  line -
405  lineto {
406  set count ""
407  if {[$txtt compare [lindex $range $index] == "[lindex $range $index] [lindex $pos $index]"]} {
408  set count [expr {($motion eq "next") ? "+$number display lines" : "-$number display lines"}]
409  }
410  lset range $index [$txtt index "[lindex $range $index]$count [lindex $pos $index]"]
411  }
412  node {
413  if {$data($txtt,anchorend) == 0} {
414  if {[set node_range [node_${motion}_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
415  lset range 1 [lindex $node_range 1]
416  }
417  } else {
418  if {[set node_range [node_${motion}_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
419  lset range 0 [lindex $node_range 0]
420  }
421  }
422  }
423  curly -
424  square -
425  paren -
426  angled {
427  if {$data($txtt,anchorend) == 0} {
428  if {[set bracket_range [bracket_${motion}_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
429  lset range 1 [lindex $bracket_range 1]
430  }
431  } else {
432  if {[set bracket_range [bracket_${motion}_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
433  lset range 0 [lindex $bracket_range 0]
434  }
435  }
436  }
437  default {
438  if {($index == 1) && ($motion eq "prev") && ($data($txtt,type) eq "word")} {
439  lset range 1 [$txtt index "[lindex $range 1]-1 display chars"]
440  }
441  if {$opts(-startpos) ne ""} {
442  lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $motion -num $number -startpos $opts(-startpos)]
443  } else {
444  lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $motion -num $number -startpos [lindex $range $index]]
445  }
446  }
447  }}
448  if {([lindex $range $index] eq "") || [$txtt compare [lindex $range 0] >= [lindex $range 1]]} {
449  return
450  }
451  }
452  rshift -
453  lshift {
454  if {$data($txtt,type) eq "block"} {
455  set trange $range
456  if {$motion eq "rshift"} {
457  set range [list]
458  foreach {startpos endpos} $trange {
459  lappend range [$txtt index "$startpos+$number display chars"]
460  if {[$txtt compare "$endpos+$number display chars" < "$endpos lineend"]} {
461  lappend range [$txtt index "$endpos+$number display chars"]
462  } else {
463  lappend range [$txtt index "$endpos lineend"]
464  }
465  }
466  } elseif {[$txtt compare "[lindex $range 0]-$number display chars" >= "[lindex $range 0] linestart"]} {
467  set range [list]
468  foreach {startpos endpos} $trange {
469  lappend range [$txtt index "$startpos-$number display chars"] [$txtt index "$endpos-$number display chars"]
470  }
471  }
472  } else {
473  set pos $positions($data($txtt,type))
474  set dir [expr {($motion eq "rshift") ? "next" : "prev"}]
475  if {($motion eq "lshift") && ([lsearch [list word tag] $data($txtt,type)] != -1)} {
476  lset range 1 [$txtt index "[lindex $range 1]-1 display chars"]
477  }
478  foreach index {0 1} {
479  lset range $index [edit::get_index $txtt {*}[lindex $pos $index] -dir $dir -num $number -startpos [lindex $range $index]]
480  }
481  }
482  }
483  ushift {
484  switch $data($txtt,type) {
485  line {
486  if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
487  if {[$txtt compare [lindex $range 0] > 1.0]} {
488  lset range 0 [$txtt index "[lindex $range 0]-$number display lines linestart"]
489  lset range 1 [$txtt index "[lindex $range 1]-$number display lines lineend"]
490  }
491  }
492  }
493  node {
494  if {[set node_range0 [node_prev_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
495  if {[set node_range1 [node_prev_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
496  lset range 0 [lindex $node_range0 0]
497  lset range 1 [lindex $node_range1 1]
498  }
499  }
500  }
501  curly -
502  square -
503  paren -
504  angled {
505  if {[set bracket_range0 [bracket_prev_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
506  if {[set bracket_range1 [bracket_prev_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
507  lset range 0 [lindex $bracket_range0 0]
508  lset range 1 [lindex $bracket_range1 1]
509  }
510  }
511  }
512  default {
513  if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
514  set trange $range
515  set range [list]
516  foreach {pos} $trange {
517  lappend range [$txtt index "$pos-$number display lines"]
518  }
519  }
520  }
521  }}
522  }
523  dshift {
524  switch $data($txtt,type) {
525  line {
526  if {[$txtt compare "[lindex $range end]+$number display lines" > "[lindex $range end] lineend"]} {
527  if {[$txtt compare [lindex $range 1] < "end-1 display lines lineend"]} {
528  lset range 1 [$txtt index "[lindex $range 1]+$number display lines lineend"]
529  lset range 0 [$txtt index "[lindex $range 0]+$number display lines linestart"]
530  }
531  }
532  }
533  node {
534  if {[set node_range1 [node_next_sibling [winfo parent $txtt] "[lindex $range 1]-1c"]] ne ""} {
535  if {[set node_range0 [node_next_sibling [winfo parent $txtt] "[lindex $range 0]+1c"]] ne ""} {
536  lset range 0 [lindex $node_range0 0]
537  lset range 1 [lindex $node_range1 1]
538  }
539  }
540  }
541  curly -
542  square -
543  paren -
544  angled {
545  if {[set bracket_range0 [bracket_next_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
546  if {[set bracket_range1 [bracket_next_sibling $txtt $data($txtt,type) {*}$range]] ne ""} {
547  lset range 0 [lindex $bracket_range0 0]
548  lset range 1 [lindex $bracket_range1 1]
549  }
550  }
551  }
552  default {
553  if {[$txtt compare "[lindex $range end]+$number display lines" > "[lindex $range end] lineend"]} {
554  set trange $range
555  set range [list]
556  foreach {pos} $trange {
557  lappend range [$txtt index "$pos+$number display lines"]
558  }
559  }
560  }
561  }}
562  }
563  left {
564  if {$data($txtt,anchorend) == 1} {
565  set i 0
566  foreach {startpos endpos} $range {
567  if {[$txtt compare "$startpos-$number display chars" >= "$startpos linestart"]} {
568  lset range $i [$txtt index "$startpos-$number display chars"]
569  incr i 2
570  }
571  }
572  } else {
573  set i 1
574  foreach {startpos endpos} $range {
575  if {[$txtt compare "$endpos-$number display chars" > $startpos]} {
576  lset range $i [$txtt index "$endpos-$number display chars"]
577  }
578  incr i 2
579  }
580  }
581  }
582  right {
583  if {$data($txtt,anchorend) == 1} {
584  set i 0
585  foreach {startpos endpos} $range {
586  if {[$txtt compare "$startpos+$number display chars" < $endpos]} {
587  lset range $i [$txtt index "$startpos+$number display chars"]
588  }
589  incr i 2
590  }
591  } else {
592  set i 1
593  foreach {startpos endpos} $range {
594  if {[$txtt compare "$endpos+$number display chars" <= "$endpos lineend"]} {
595  lset range $i [$txtt index "$endpos+$number display chars"]
596  }
597  incr i 2
598  }
599  }
600  }
601  up {
602  if {$data($txtt,type) eq "block"} {
603  if {$data($txtt,anchorend) == 1} {
604  if {[$txtt compare "insert-$number display lines" < [lindex $range 0]]} {
605  set nrow [lindex [split [$txtt index "insert-$number display lines"] .] 0]
606  set ocol1 [$txtt count -displaychars "[lindex $range end-1] linestart" [lindex $range end-1]]
607  set ocol2 [$txtt count -displaychars "[lindex $range end] linestart" [lindex $range end]]
608  for {set i 0} {$i < $number} {incr i} {
609  lappend trange $nrow.$ocol1 $nrow.$ocol2
610  incr nrow
611  }
612  set range [list {*}$trange {*}$range]
613  }
614  } else {
615  if {[$txtt compare "insert-$number display lines" >= [lindex $range 0]]} {
616  set range [lreplace $range end-[expr ($number * 2) - 1] end]
617  }
618  }
619  } else {
620  if {$data($txtt,anchorend) == 1} {
621  if {[$txtt compare "[lindex $range 0]-$number display lines" < [lindex $range 0]]} {
622  lset range 0 [$txtt index "[lindex $range 0]-$number display lines"]
623  }
624  } else {
625  if {[$txtt compare "[lindex $range 1]-$number display lines" > [lindex $range 0]]} {
626  lset range 1 [$txtt index "[lindex $range 1]-$number display lines"]
627  }
628  }
629  }
630  }
631  down {
632  if {$data($txtt,type) eq "block"} {
633  if {$data($txtt,anchorend) == 1} {
634  if {[$txtt compare "insert+$number display lines" <= [lindex $range end-1]]} {
635  set range [lreplace $range 0 [expr ($number * 2) - 1]]
636  }
637  } else {
638  if {[$txtt compare "insert+$number display lines" < end]} {
639  set nrow [lindex [split [$txtt index "insert+$number display lines"] .] 0]
640  set ocol1 [$txtt count -displaychars "[lindex $range 0] linestart" [lindex $range 0]]
641  set ocol2 [$txtt count -displaychars "[lindex $range 1] linestart" [lindex $range 1]]
642  for {set i 0} {$i < $number} {incr i} {
643  lappend trange $nrow.$ocol2 $nrow.$ocol1
644  incr nrow -1
645  }
646  lappend range {*}[lreverse $trange]
647  }
648  }
649  } else {
650  if {$data($txtt,anchorend) == 1} {
651  if {[$txtt compare "[lindex $range 0]+$number display lines" < [lindex $range 1]]} {
652  lset range 0 [$txtt index "[lindex $range 0]+$number display lines"]
653  }
654  } else {
655  if {[$txtt compare "[lindex $range 1]+$number display lines" < end]} {
656  lset range 1 [$txtt index "[lindex $range 1]+$number display lines"]
657  }
658  }
659  }
660  }
661  parent {
662  switch $data($txtt,type) {
663  node { set trange [node_parent [winfo parent $txtt] {*}$range]}
664  default { set trange [bracket_parent $txtt $data($txtt,type) {*}$range]}
665  }}
666  if {$trange ne ""} {
667  set range $trange
668  }
669  }
670  child {
671  if {$data($txtt,anchorend) == 0} {
672  switch $data($txtt,type) {
673  node { set trange [node_first_child [winfo parent $txtt] [lindex $range 0]]}
674  default { set trange [bracket_first_child $txtt $data($txtt,type) {*}$range]}
675  }}
676  } else {
677  switch $data($txtt,type) {
678  node { set trange [node_last_child [winfo parent $txtt] [lindex $range 0]] }
679  default { set trange [bracket_last_child $txtt $data($txtt,type) {*}$range] }
680  }
681  }
682  if {$trange ne ""} {
683  set range $trange
684  }
685  }
686  }}
687 
688  # If the range was not set to a valid range, return now
689  if {[set cursor [lindex $range [expr {$data($txtt,anchorend) ? 0 : "end"}]]] eq ""} {
690  return
691  }
692 
693  # Set the cursor and selection
694  set data($txtt,dont_close) 1
695  set index [expr {($data($txtt,anchorend) == 0) ? 0 : "end"}]
696  set data($txtt,anchor) [lindex $range $index]
697  ::tk::TextSetCursor $txtt $cursor
698  foreach {startpos endpos} $range {
699  $txtt tag add sel $startpos $endpos
700  }
701 
702  # Add the information to the undo buffer
703  lappend data($txtt,undo) [list $data($txtt,type) $data($txtt,anchorend) $range]
704 
705  }}