TKE  3.6
Advanced code editor for programmers
ctext Namespace Reference

Functions

 create win args
 
 event:xscroll win clientData args
 
 event:yscroll win clientData args
 
 event:Destroy win
 
 buildArgParseTable win
 
 update_linemap_separator win
 
 inCommentStringHelper win index pattern
 
 inLineComment win index
 
 inBlockComment win index
 
 inComment win index
 
 inBackTick win index
 
 inSingleQuote win index
 
 inDoubleQuote win index
 
 inTripleBackTick win index
 
 inTripleSingleQuote win index
 
 inTripleDoubleQuote win index
 
 inString win index
 
 inCommentString win index
 
 inCommentStringRangeHelper win index pattern prange
 
 inLineCommentRange win index prange
 
 inBlockCommentRange win index prange
 
 inCommentRange win index prange
 
 commentCharRanges win index
 
 inBackTickRange win index prange
 
 inSingleQuoteRange win index prange
 
 inDoubleQuoteRange win index prange
 
 inTripleBackTickRange win index prange
 
 inTripleSingleQuoteRange win index prange
 
 inTripleDoubleQuoteRange win index prange
 
 inStringRange win index prange
 
 inCommentStringRange win index prange
 
 inBlockRange win type index prange
 
 handleFocusIn win
 
 handleFocusOut win
 
 set_border_color win color
 
 isEscaped win index
 
 undo_display win
 
 undo_separator win
 
 undo_manage win
 
 undo_insert win insert_pos str_len cursor
 
 undo_delete win start_pos end_pos
 
 undo_get_cursor_hist win
 
 undo win
 
 redo win
 
 getGutterTags win pos
 
 handleInsertAt0 win startpos datalen
 
 handleDeleteAt0Helper win firstpos endpos
 
 handleDeleteAt0 win startpos endpos
 
 handleReplaceDeleteAt0 win startpos endpos
 
 handleReplaceInsert win startpos datalen tags
 
 instanceCmd win cmd args
 
 command_append win args
 
 command_cget win args
 
 command_configure win args
 
 command_copy win args
 
 command_cut win args
 
 command_delete win args
 
 command_diff win args
 
 command_fastdelete win args
 
 command_fastinsert win args
 
 command_fastreplace win args
 
 command_highlight win args
 
 command_insert win args
 
 command_is win args
 
 isQuote win char index side
 
 command_replace win args
 
 command_paste win args
 
 command_peer win args
 
 command_syntax win args
 
 command_tag win args
 
 command_edit win args
 
 command_gutter win args
 
 execute_gutter_cmd win y cmd
 
 getAutoMatchChars win lang
 
 setAutoMatchChars win lang matchChars
 
 matchBracket win
 
 getPrevBracket win stype ?index?
 
 getNextBracket win stype ?index?
 
 getMatchBracket win stype ?index?
 
 matchPair win lang pos type
 
 matchQuote win lang pos tag type
 
 checkAllBrackets win ?str?
 
 checkBracketType win stype
 
 gotoBracketMismatch win dir args
 
 getLang win index
 
 clearCommentStringPatterns win
 
 addBlockCommentPatterns win lang patterns
 
 addLineCommentPatterns win lang patterns
 
 addStringPatterns win lang types
 
 addEmbedLangPattern win lang patterns
 
 highlightAll win lineranges ins ?do_tag?
 
 getTagInRange win tag start end
 
 comments_chars_deleted win start end pdo_tags
 
 comments_do_tag win start end pdo_tags
 
 comments win ranges do_tags
 
 updateLangBackgrounds win
 
 setIndentation twin lang indentations type
 
 escapes win start end
 
 prewhite win start end
 
 brackets win start end lang ptags
 
 indentation win start end lang ptags
 
 words win start end lang ins ptags
 
 regexps win start end lang ins ptags
 
 searches win start end ptags
 
 updateMetaChars win
 
 add_font_opts win modifiers popts
 
 addHighlightKeywords win type value keywords ?lang?
 
 addHighlightRegexp win type value re ?lang?
 
 addHighlightWithOnlyCharStart win type value char ?lang?
 
 highlightSearch win class str ?opts?
 
 checkHighlightClass win class
 
 addHighlightClass win class args
 
 handleClickCommand win tag command
 
 applyClassTheme win class
 
 deleteHighlightClass win class
 
 deleteHighlightCommand win command
 
 getHighlightClasses win ?index?
 
 highlight win start end ins
 
 linemapCheckOnDelete win startpos ?endpos?
 
 linemapToggleMark win x y
 
 linemapSetMark win line
 
 linemapClearMark win line
 
 linemapUpdateNeeded win
 
 linemapUpdate win ?forceUpdate?
 
 linemapUpdateGutter win ptags x y
 
 linemapDiffUpdate win first last linenum_width
 
 linemapLineUpdate win first last linenum_width
 
 linemapGutterUpdate win first last linenum_width
 
 linemapMarkUpdate win first last
 
 doConfigure win
 
 set_warnwidth win ?adjust?
 
 set_rmargin win startpos endpos
 
 adjust_rmargin win
 
 modified win value ?dat?
 

Function Documentation

§ add_font_opts()

ctext::add_font_opts   win modifiers popts  

Definition at line 3869 of file ctext.tcl.

3869  proc add_font_opts {win modifiers popts} {
3870 
3871  variable data
3872 
3873  upvar $popts opts
3874 
3875  if {[llength $modifiers] == 0} return
3876 
3877  array set font_opts [font configure [$win cget -font]]
3878  array set line_opts [list]
3879  array set tag_opts [list]
3880 
3881  set lsize ""
3882  set superscript 0
3883  set subscript 0
3884  set name_list [list 0 0 0 0 0 0]
3885 
3886  foreach modifier $modifiers {
3887  switch $modifier {
3888  "bold" { set font_opts(-weight) "bold"; lset name_list 0 1}
3889  "italics" { set font_opts(-slant) "italic"; lset name_list 1 1}
3890  "underline" { set font_opts(-underline) 1; lset name_list 2 1}
3891  "overstrike" { set tag_opts(-overstrike) 1; lset name_list 3 1}
3892  "h6" { set font_opts(-size) [expr $font_opts(-size) + 1]; set lsize "6"}
3893  "h5" { set font_opts(-size) [expr $font_opts(-size) + 2]; set lsize "5"}
3894  "h4" { set font_opts(-size) [expr $font_opts(-size) + 3]; set lsize "4"}
3895  "h3" { set font_opts(-size) [expr $font_opts(-size) + 4]; set lsize "3"}
3896  "h2" { set font_opts(-size) [expr $font_opts(-size) + 5]; set lsize "2"}
3897  "h1" { set font_opts(-size) [expr $font_opts(-size) + 6]; set lsize "1"}
3898  "superscript" {
3899  set lsize "super"
3900  set size [expr $font_opts(-size) - 2]
3901  set font_opts(-size) $size
3902  set line_opts(-offset) [expr $size / 2]
3903  lset name_list 4 1
3904  }
3905  "subscript" {
3906  set lsize "sub"
3907  set size [expr $font_opts(-size) - 2]
3908  set font_opts(-size) $size
3909  set line_opts(-offset) [expr 0 - ($size / 2)]
3910  lset name_list 5 1
3911  }
3912  }
3913  }
3914 
3915  set fontname ctext-[join $name_list ""]$lsize
3916  if {[lsearch [font names] $fontname] == -1} {
3917  font create $fontname {*}[array get font_opts]
3918  }
3919 
3920  lappend opts -font $fontname {*}[array get tag_opts] {*}[array get line_opts]
3921 
3922  }

§ addBlockCommentPatterns()

ctext::addBlockCommentPatterns   win lang patterns  

Definition at line 3097 of file ctext.tcl.

3097  proc addBlockCommentPatterns {win lang patterns} {
3098 
3099  variable data
3100 
3101  set start_patterns [list]
3102  set end_patterns [list]
3103 
3104  foreach pattern $patterns {
3105  lappend start_patterns [lindex $pattern 0]
3106  lappend end_patterns [lindex $pattern 1]
3107  }
3108 
3109  if {[llength $patterns] > 0} {
3110  lappend data($win,config,csl_patterns,$lang) __cCommentStart:$lang "" ([join $start_patterns |])
3111  lappend data($win,config,csl_patterns,$lang) __cCommentEnd:$lang "" ([join $end_patterns |])
3112  }
3113 
3114  array set tags [list __cCommentStart:${lang}0 1 __cCommentStart:${lang}1 1 __cCommentEnd:${lang}0 1 __cCommentEnd:${lang}1 1 __comstr1c0 1 __comstr1c1 1]
3115 
3116  if {[llength $patterns] > 0} {
3117  array set theme $data($win,config,-theme)
3118  $win tag configure __comstr1c0 -foreground $theme(comments)
3119  $win tag configure __comstr1c1 -foreground $theme(comments)
3120  $win tag lower __comstr1c0 _visibleH
3121  $win tag lower __comstr1c1 _visibleH
3122  foreach tag [list __cCommentStart:${lang}0 __cCommentStart:${lang}1 __cCommentEnd:${lang}0 __cCommentEnd:${lang}1] {
3123  $win tag configure $tag
3124  $win tag lower $tag _invisible
3125  }
3126  lappend data($win,config,csl_char_tags,$lang) __cCommentStart:$lang __cCommentEnd:$lang
3127  lappend data($win,config,csl_array) {*}[array get tags]
3128  lappend data($win,config,csl_markers) __cCommentStart:${lang}0 __cCommentStart:${lang}1 __cCommentEnd:${lang}0 __cCommentEnd:${lang}1
3129  lappend data($win,config,csl_tag_pair) __cCommentStart:$lang __comstr1c
3130  lappend data($win,config,csl_tags) __comstr1c0 __comstr1c1
3131  } else {
3132  catch { $win tag delete {*}[array names tags]}
3133  }
3134 
3135  }

§ addEmbedLangPattern()

ctext::addEmbedLangPattern   win lang patterns  

Definition at line 3251 of file ctext.tcl.

3251  proc addEmbedLangPattern {win lang patterns} {
3252 
3253  variable data
3254 
3255  # Coallesce the start/end patterns
3256  foreach pattern $patterns {
3257  lassign $pattern spat epat
3258  lappend start_patterns $spat
3259  lappend end_patterns $epat
3260  }
3261 
3262  lappend data($win,config,csl_patterns,) __LangStart:$lang "" ([join $start_patterns |]) __LangEnd:$lang "" ([join $end_patterns |])
3263  lappend data($win,config,langs) $lang
3264 
3265  array set theme $data($win,config,-theme)
3266 
3267  $win tag configure __Lang:$lang
3268  $win tag lower __Lang:$lang _invisible
3269  $win tag configure __Lang=$lang -background $theme(embedded)
3270  $win tag lower __Lang=$lang _invisible
3271 
3272  lappend data($win,config,csl_char_tags,) __LangStart:$lang __LangEnd:$lang
3273  lappend data($win,config,csl_array) __LangStart:${lang}0 1 __LangStart:${lang}1 1 __LangEnd:${lang}0 1 __LangEnd:${lang}1 1 __Lang:$lang 1
3274  lappend data($win,config,csl_markers) __LangStart:${lang}0 __LangStart:${lang}1 __LangEnd:${lang}0 __LangEnd:${lang}1
3275  lappend data($win,config,csl_tag_pair) __LangStart:$lang __Lang=$lang
3276 
3277  }

§ addHighlightClass()

ctext::addHighlightClass   win class args  

Definition at line 4011 of file ctext.tcl.

4011  proc addHighlightClass {win class args} {
4012 
4013  variable data
4014  variable right_click
4015 
4016  array set opts {
4017  -fgtheme ""
4018  -bgtheme ""
4019  -fontopts ""
4020  -clickcmd ""
4021  -priority ""
4022  -immediate 0
4023  -meta 0
4024  }
4025  array set opts $args
4026 
4027  # Configure the class tag and place it in the correct position in the tag stack
4028  $win._t tag configure __$class
4029  if {$opts(-priority) ne ""} {
4030  switch $opts(-priority) {
4031  1 { $win._t tag lower __$class _visibleH}
4032  2 { $win._t tag raise __$class _visibleL}
4033  3 { $win._t tag lower __$class _visibleL}
4034  4 { $win._t tag raise __$class _invisible}
4035  high { $win._t tag raise __$class _visibleH}
4036  }
4037  } elseif {$opts(-bgtheme) ne ""} {
4038  $win._t tag lower __$class _visibleL
4039  } elseif {($opts(-fgtheme) ne "") || ($opts(-fontopts) ne "")} {
4040  $win._t tag raise __$class _visibleL
4041  } else {
4042  $win._t tag lower __$class _invisible
4043  }
4044 
4045  if {$opts(-meta)} {
4046  lappend data($win,config,meta_classes) $class
4047  $win._t tag configure __$class -elide $data($win,config,-hidemeta)
4048  }
4049 
4050  # If there is a command associated with the class, bind it to the right-click button
4051  if {$opts(-clickcmd) ne ""} {
4052  $win._t tag bind __$class <Button-$right_click> [list ctext::handleClickCommand $win __$class $opts(-clickcmd)]
4053  }
4054 
4055  # Save the class name and options
4056  set data($win,classopts,$class) [array get opts]
4057  set data($win,classimmediate,$class) $opts(-immediate)
4058 
4059  # Apply the class theming information
4060  applyClassTheme $win $class
4061 
4062  }

§ addHighlightKeywords()

ctext::addHighlightKeywords   win type value keywords ?lang?  

Definition at line 3924 of file ctext.tcl.

3924  proc addHighlightKeywords {win type value keywords {lang ""}} {
3925 
3926  variable data
3927 
3928  if {$type eq "class"} {
3929  checkHighlightClass $win $value
3930  set value __$value
3931  }
3932 
3933  foreach word $keywords {
3934  set data($win,highlight,wkeyword,$type,$lang,$word) $value
3935  }
3936 
3937  }

§ addHighlightRegexp()

ctext::addHighlightRegexp   win type value re ?lang?  

Definition at line 3939 of file ctext.tcl.

3939  proc addHighlightRegexp {win type value re {lang ""}} {
3940 
3941  variable data
3942 
3943  if {$type eq "class"} {
3944  checkHighlightClass $win $value
3945  set value __$value
3946  }
3947 
3948  if {![info exists data($win,highlight,regexps,$lang)]} {
3949  set index 0
3950  } else {
3951  set index [llength $data($win,highlight,regexps,$lang)]
3952  }
3953 
3954  lappend data($win,highlight,regexps,$lang) "regexp,$type,$lang,$value,$index"
3955 
3956  set data($win,highlight,regexp,$type,$lang,$value,$index) [list $re $data($win,config,re_opts)]
3957 
3958  }

§ addHighlightWithOnlyCharStart()

ctext::addHighlightWithOnlyCharStart   win type value char ?lang?  

Definition at line 3961 of file ctext.tcl.

3961  proc addHighlightWithOnlyCharStart {win type value char {lang ""}} {
3962 
3963  variable data
3964 
3965  if {$type eq "class"} {
3966  checkHighlightClass $win $value
3967  set value __$value
3968  }
3969 
3970  set data($win,highlight,wcharstart,$type,$lang,$char) $value
3971 
3972  }

§ addLineCommentPatterns()

ctext::addLineCommentPatterns   win lang patterns  

Definition at line 3137 of file ctext.tcl.

3137  proc addLineCommentPatterns {win lang patterns} {
3138 
3139  variable data
3140 
3141  if {[llength $patterns] > 0} {
3142  lappend data($win,config,csl_patterns,$lang) __lCommentStart:$lang "" ([join $patterns |])
3143  }
3144 
3145  array set tags [list __lCommentStart:${lang}0 1 __lCommentStart:${lang}1 1 __comstr1l 1]
3146 
3147  if {[llength $patterns] > 0} {
3148  array set theme $data($win,config,-theme)
3149  $win tag configure __comstr1l -foreground $theme(comments)
3150  $win tag lower __comstr1l _visibleH
3151  foreach tag [list __lCommentStart:${lang}0 __lCommentStart:${lang}1] {
3152  $win tag configure $tag
3153  $win tag lower $tag _invisible
3154  }
3155  lappend data($win,config,lc_char_tags,$lang) __lCommentStart:$lang
3156  lappend data($win,config,csl_array) {*}[array get tags]
3157  lappend data($win,config,csl_markers) __lCommentStart:${lang}0 __lCommentStart:${lang}1
3158  lappend data($win,config,csl_tags) __comstr1l
3159  } else {
3160  catch { $win tag delete {*}[array names tags]}
3161  }
3162 
3163  }

§ addStringPatterns()

ctext::addStringPatterns   win lang types  

Definition at line 3165 of file ctext.tcl.

3165  proc addStringPatterns {win lang types} {
3166 
3167  variable data
3168 
3169  set csl_patterns [list]
3170 
3171  # Combine types
3172  array set type_array [list]
3173  foreach type $types { set type_array($type) 1}
3174  foreach {val pat1 pat2} [list double (\") (\"\"\") single (') (''') btick (`) (```)] {
3175  set c [string index $val 0]
3176  if {[info exists type_array($val)]} {
3177  if {[info exists type_array(triple$val)]} {
3178  lappend csl_patterns "__${c}Quote:$lang" "__[string toupper $c]Quote:$lang" $pat1|$pat2
3179  unset type_array(triple$val)
3180  } else {
3181  lappend csl_patterns "__${c}Quote:$lang" "" $pat1
3182  }
3183  unset type_array($val)
3184  } elseif {[info exists type_array(triple$val)]} {
3185  lappend csl_patterns "__[string toupper $c]Quote:$lang" "" $pat2
3186  unset type_array(triple$val)
3187  }
3188  }
3189  foreach type [array names type_array] {
3190  lappend csl_patterns "__sQuote:$lang" "" $type
3191  }
3192 
3193  array set tags [list \
3194  __sQuote:${lang}0 1 __sQuote:${lang}1 1 \
3195  __SQuote:${lang}0 1 __SQuote:${lang}1 1 \
3196  __dQuote:${lang}0 1 __dQuote:${lang}1 1 \
3197  __DQuote:${lang}0 1 __DQuote:${lang}1 1 \
3198  __bQuote:${lang}0 1 __bQuote:${lang}1 1 \
3199  __BQuote:${lang}0 1 __BQuote:${lang}1 1 \
3200  __comstr0s0 1 __comstr0s1 1 \
3201  __comstr0S0 1 __comstr0S1 1 \
3202  __comstr0d0 1 __comstr0d1 1 \
3203  __comstr0D0 1 __comstr0D1 1 \
3204  __comstr0b0 1 __comstr0b1 1 \
3205  __comstr0B0 1 __comstr0B1 1]
3206 
3207  array set comstr [list \
3208  __dQuote:$lang __comstr0d \
3209  __DQuote:$lang __comstr0D \
3210  __sQuote:$lang __comstr0s \
3211  __SQuote:$lang __comstr0S \
3212  __bQuote:$lang __comstr0b \
3213  __BQuote:$lang __comstr0B]
3214 
3215  if {[llength $types] > 0} {
3216  array set theme $data($win,config,-theme)
3217  foreach {tag1 tag2 pattern} $csl_patterns {
3218  foreach rb {0 1} {
3219  $win tag configure $comstr($tag1)$rb -foreground $theme(strings)
3220  $win tag configure $tag1$rb
3221  $win tag lower $comstr($tag1)$rb _visibleH
3222  $win tag lower $tag1$rb _invisible
3223  lappend data($win,config,csl_tags) $comstr($tag1)$rb
3224  }
3225  lappend data($win,config,csl_char_tags,$lang) $tag1
3226  if {$tag2 ne ""} {
3227  foreach rb {0 1} {
3228  $win tag configure $comstr($tag2)$rb -foreground $theme(strings)
3229  $win tag configure $tag2$rb
3230  $win tag lower $comstr($tag2)$rb _visibleH
3231  $win tag lower $tag2$rb _invisible
3232  }
3233  lappend data($win,config,csl_char_tags,$lang) $tag2
3234  lappend data($win,config,csl_tags) $comstr($tag2)$rb
3235  }
3236  }
3237  lappend data($win,config,csl_patterns,$lang) {*}$csl_patterns
3238  lappend data($win,config,csl_array) {*}[array get tags]
3239  lappend data($win,config,csl_markers) __dQuote:${lang}0 __dQuote:${lang}1 __DQuote:${lang}0 __DQuote:${lang}1 \
3240  __sQuote:${lang}0 __sQuote:${lang}1 __SQuote:${lang}0 __SQuote:${lang}1 \
3241  __bQuote:${lang}0 __bQuote:${lang}1 __BQuote:${lang}0 __BQuote:${lang}1
3242  lappend data($win,config,csl_tag_pair) {*}[array get comstr]
3243  } else {
3244  catch { $win tag delete {*}[array names tags]}
3245  }
3246 
3247  }

§ adjust_rmargin()

ctext::adjust_rmargin   win  

Definition at line 4559 of file ctext.tcl.

4559  proc adjust_rmargin {win} {
4560 
4561  # If the warning width indicator is absent, remove rmargin and return
4562  if {[lsearch [place slaves $win.t] $win.t.w] == -1} {
4563  $win tag configure rmargin -rmargin ""
4564  return
4565  }
4566 
4567  # Calculate the rmargin value to use
4568  set rmargin [expr [winfo width $win.t] - [lindex [place configure $win.t.w -x] 4]]
4569 
4570  # Set the rmargin
4571  if {$rmargin > 0} {
4572  $win tag configure rmargin -rmargin $rmargin
4573  } else {
4574  $win tag configure rmargin -rmargin ""
4575  }
4576 
4577  }

§ applyClassTheme()

ctext::applyClassTheme   win class  

Definition at line 4078 of file ctext.tcl.

4078  proc applyClassTheme {win class} {
4079 
4080  variable data
4081 
4082  array set opts $data($win,classopts,$class)
4083  array set themes $data($win,config,-theme)
4084 
4085  set tag_opts [list]
4086 
4087  if {([set fgtheme $opts(-fgtheme)] ne "") && [info exists themes($fgtheme)]} {
4088  lappend tag_opts -foreground $themes($fgtheme)
4089  }
4090 
4091  if {([set bgtheme $opts(-bgtheme)] ne "") && [info exists themes($bgtheme)]} {
4092  lappend tag_opts -background $themes($bgtheme)
4093  }
4094 
4095  if {$opts(-fontopts) ne ""} {
4096  add_font_opts $win $opts(-fontopts) tag_opts
4097  }
4098 
4099  catch { $win._t tag configure __$class {*}$tag_opts}
4100 
4101  }

§ brackets()

ctext::brackets   win start end lang ptags  

Definition at line 3671 of file ctext.tcl.

3671  proc brackets {win start end lang ptags} {
3672 
3673  upvar $ptags tags
3674 
3675  variable data
3676  variable REs
3677  variable bracket_map
3678 
3679  array set ttags {}
3680 
3681  # Handle special character matching
3682  set row [lindex [split $start .] 0]
3683  foreach line [split [$win._t get $start $end] \n] {
3684  set col 0
3685  while {[regexp -indices -start $col -- $REs(brackets) $line res]} {
3686  set scol [lindex $res 0]
3687  set col [expr $scol + 1]
3688  lappend ttags(__$bracket_map([string index $line $scol])) $row.$scol $row.$col
3689  }
3690  incr row
3691  }
3692 
3693  foreach tag [array names ttags] {
3694  if {[info exists data($win,config,matchChar,$lang,[string range $tag 2 end-1])]} {
3695  dict lappend tags $tag {*}$ttags($tag)
3696  }
3697  }
3698 
3699  }

§ buildArgParseTable()

ctext::buildArgParseTable   win  

Definition at line 278 of file ctext.tcl.

278  proc buildArgParseTable win {
279 
280  variable data
281 
282  set argTable [list]
283 
284  lappend argTable any -background {
285  if {[catch { winfo rgb $win $value } res]} {
286  return -code error $res
287  }
288  set data($win,config,-background) $value
289  $win.t configure -bg $value
290  update_linemap_separator $win
291  break
292  }
293 
294  lappend argTable any -linemap_separator {
295  set data($win,config,-linemap_separator) $value
296  update_linemap_separator $win
297  break
298  }
299 
300  lappend argTable any -linemap_separator_color {
301  if {[catch {winfo rgb $win $value} res]} {
302  return -code error $res
303  }
304  set data($win,config,-linemap_separator_color) $value
305  $win.f configure -bg $value
306  update_linemap_separator $win
307  break
308  }
309 
310  lappend argTable {1 true yes} -linemap {
311  set data($win,config,-linemap) 1
312  catch {
313  grid $win.l
314  grid $win.f
315  }
316  set update_linemap 1
317  break
318  }
319 
320  lappend argTable {0 false no} -linemap {
321  set data($win,config,-linemap) 0
322  if {([llength $data($win,config,gutters)] == 0) && !$data($win,config,-linemap_markable) && !$data($win,config,-folding)} {
323  catch {
324  grid remove $win.l
325  grid remove $win.f
326  }
327  } else {
328  set update_linemap 1
329  }
330  break
331  }
332 
333  lappend argTable any -linemap_mark_command {
334  set data($win,config,-linemap_mark_command) $value
335  break
336  }
337 
338  lappend argTable {1 true yes} -folding {
339  set data($win,config,-folding) 1
340  catch {
341  grid $win.l
342  grid $win.f
343  }
344  set update_linemap 1
345  break
346  }
347 
348  lappend argTable {0 false no} -folding {
349  set data($win,config,-folding) 0
350  if {([llength $data($win,config,gutters)] == 0) && !$data($win,config,-linemap_markable) && !$data($win,config,-linemap)} {
351  catch {
352  grid remove $win.l
353  grid remove $win.f
354  }
355  } else {
356  set update_linemap 1
357  }
358  break
359  }
360 
361  lappend argTable any -xscrollcommand {
362  set cmd [list $win._t config -xscrollcommand [list ctext::event:xscroll $win $value]]
363  if {[catch $cmd res]} {
364  return $res
365  }
366  set data($win,config,-xscrollcommand) $value
367  break
368  }
369 
370  lappend argTable any -yscrollcommand {
371  set cmd [list $win._t config -yscrollcommand [list ctext::event:yscroll $win $value]]
372  if {[catch $cmd res]} {
373  return $res
374  }
375  set data($win,config,-yscrollcommand) $value
376  break
377  }
378 
379  lappend argTable any -spacing3 {
380  if {[catch { $win._t config -spacing3 $value } res]} {
381  return $res
382  }
383  }
384 
385  lappend argTable any -linemapfg {
386  if {[catch {winfo rgb $win $value} res]} {
387  return -code error $res
388  }
389  $win.l itemconfigure unmarked -fill $value
390  set data($win,config,-linemapfg) $value
391  break
392  }
393 
394  lappend argTable any -linemapbg {
395  if {[catch {winfo rgb $win $value} res]} {
396  return -code error $res
397  }
398  $win.l config -bg $value
399  set data($win,config,-linemapbg) $value
400  break
401  }
402 
403  lappend argTable any -linemap_relief {
404  if {[catch {$win.l config -relief $value} res]} {
405  return -code error $res
406  }
407  set data($win,config,-linemap_relief) $value
408  break
409  }
410 
411  lappend argTable any -font {
412  $win._t config -font $value
413  set data($win,config,-font) $value
414  set data($win,fontwidth) [font measure $value -displayof $win "0"]
415  set data($win,fontdescent) [font metrics $data($win,config,-font) -displayof $win -descent]
416  set update_linemap 1
417  set_warnwidth $win
418  break
419  }
420 
421  lappend argTable {0 false no} -highlight {
422  set data($win,config,-highlight) 0
423  break
424  }
425 
426  lappend argTable {1 true yes} -highlight {
427  set data($win,config,-highlight) 1
428  break
429  }
430 
431  lappend argTable any -lmargin {
432  if {[string is integer $value] && ($value >= 0)} {
433  set data($win,config,-lmargin) $value
434  set_warnwidth $win
435  $win tag configure lmargin -lmargin1 $value -lmargin2 $value
436  } else {
437  return -code error "Error: -lmargin option must be an integer value greater or equal to zero"
438  }
439  break
440  }
441 
442  lappend argTable any -warnwidth {
443  set data($win,config,-warnwidth) $value
444  set_warnwidth $win
445  break
446  }
447 
448  lappend argTable any -warnwidth_bg {
449  if {[catch {winfo rgb $win $value} res]} {
450  return -code error $res
451  }
452  set data($win,config,-warnwidth_bg) $value
453  $win.t.w configure -bg $value
454  break
455  }
456 
457  lappend argTable any -highlightcolor {
458  if {[catch {winfo rgb $win $value} res]} {
459  return -code error $res
460  }
461  set data($win,config,-highlightcolor) $value
462  break
463  }
464 
465  lappend argTable {0 false no} -linemap_markable {
466  set data($win,config,-linemap_markable) 0
467  break
468  }
469 
470  lappend argTable {1 true yes} -linemap_markable {
471  set data($win,config,-linemap_markable) 1
472  break
473  }
474 
475  lappend argTable any -linemap_mark_color {
476  if {[catch {winfo rgb $win $value} res]} {
477  return -code error $res
478  }
479  set data($win,config,-linemap_mark_color) $value
480  set update_linemap 1
481  break
482  }
483 
484  lappend argTable {0 false no} -casesensitive {
485  set data($win,config,-casesensitive) 0
486  set data($win,config,re_opts) "-nocase"
487  break
488  }
489 
490  lappend argTable {1 true yes} -casesensitive {
491  set data($win,config,-casesensitive) 1
492  set data($win,config,re_opts) ""
493  break
494  }
495 
496  lappend argTable {0 false no} -escapes {
497  set data($win,config,-escapes) 0
498  break
499  }
500 
501  lappend argTable {1 true yes} -escapes {
502  set data($win,config,-escapes) 1
503  break
504  }
505 
506  lappend argTable {any} -linemap_minwidth {
507  if {![string is integer $value]} {
508  return -code error "-linemap_minwidth argument must be an integer value"
509  }
510  set data($win,config,-linemap_minwidth) $value
511  set update_linemap 1
512  break
513  }
514 
515  lappend argTable {absolute relative} -linemap_type {
516  if {[lsearch [list absolute relative] $value] == -1} {
517  return -code error "-linemap_type argument must be either 'absolute' or 'relative'"
518  }
519  set data($win,config,-linemap_type) $value
520  set update_linemap 1
521  break
522  }
523 
524  lappend argTable {left right} -linemap_align {
525  set data($win,config,-linemap_align) $value
526  set update_linemap 1
527  break;
528  }
529 
530  lappend argTable {0 false no} -undo {
531  set data($win,config,-undo) 0
532  break
533  }
534 
535  lappend argTable {1 true yes} -undo {
536  set data($win,config,-undo) 1
537  break
538  }
539 
540  lappend argTable {any} -maxundo {
541  if {![string is integer $value]} {
542  return -code error "-maxundo argument must be an integer value"
543  }
544  set data($win,config,-maxundo) $value
545  undo_manage $win
546  break
547  }
548 
549  lappend argTable {0 false no} -autoseparators {
550  set data($win,config,-autoseparators) 0
551  break
552  }
553 
554  lappend argTable {1 true yes} -autoseparators {
555  set data($win,config,-autoseparators) 1
556  break
557  }
558 
559  lappend argTable {any} -diffsubbg {
560  set data($win,config,-diffsubbg) $value
561  foreach tag [lsearch -inline -all -glob [$win._t tag names] diff:B:D:*] {
562  $win._t tag configure $tag -background $value
563  }
564  break
565  }
566 
567  lappend argTable {any} -diffaddbg {
568  set data($win,config,-diffaddbg) $value
569  foreach tag [lsearch -inline -all -glob [$win._t tag names] diff:A:D:*] {
570  $win._t tag configure $tag -background $value
571  }
572  break
573  }
574 
575  lappend argTable {any} -delimiters {
576  set data($win,config,-delimiters) $value
577  break
578  }
579 
580  lappend argTable {0 false no} -matchchar {
581  set data($win,config,-matchchar) 0
582  catch { $win tag delete matchchar }
583  break
584  }
585 
586  lappend argTable {1 true yes} -matchchar {
587  set data($win,config,-matchchar) 1
588  $win tag configure matchchar -foreground $data($win,config,-matchchar_fg) -background $data($win,config,-matchchar_bg)
589  break
590  }
591 
592  lappend argTable {any} -matchchar_fg {
593  set data($win,config,-matchchar_fg) $value
594  $win tag configure matchchar -foreground $data($win,config,-matchchar_fg) -background $data($win,config,-matchchar_bg)
595  break
596  }
597 
598  lappend argTable {any} -matchchar_bg {
599  set data($win,config,-matchchar_bg) $value
600  $win tag configure matchchar -foreground $data($win,config,-matchchar_fg) -background $data($win,config,-matchchar_bg)
601  break
602  }
603 
604  lappend argTable {0 false no} -matchaudit {
605  set data($win,config,-matchaudit) 0
606  foreach type [list curly square paren angled] {
607  catch { $win tag remove missing:$type 1.0 end }
608  }
609  break
610  }
611 
612  lappend argTable {1 true yes} -matchaudit {
613  set data($win,config,-matchaudit) 1
614  checkAllBrackets $win
615  break
616  }
617 
618  lappend argTable {any} -matchaudit_bg {
619  set data($win,config,-matchaudit_bg) $value
620  foreach type [list curly square paren angled] {
621  if {[lsearch [$win tag names] missing:$type] != -1} {
622  $win tag configure missing:$type -background $value
623  $win tag raise missing:$type _visibleH
624  }
625  }
626  break
627  }
628 
629  lappend argTable any -theme {
630  set data($win,config,-theme) $value
631  foreach key [array names data $win,classopts,*] {
632  lassign [split $key ,] dummy1 dummy2 class
633  applyClassTheme $win $class
634  }
635  }
636 
637  lappend argTable {0 false no} -hidemeta {
638  set data($win,config,-hidemeta) 0
639  updateMetaChars $win
640  break
641  }
642 
643  lappend argTable {1 true yes} -hidemeta {
644  set data($win,config,-hidemeta) 1
645  updateMetaChars $win
646  break
647  }
648 
649  set data($win,config,argTable) $argTable
650 
651  }

§ checkAllBrackets()

ctext::checkAllBrackets   win ?str?  

Definition at line 2947 of file ctext.tcl.

2947  proc checkAllBrackets {win {str ""}} {
2948 
2949  variable data
2950 
2951  # If the mismcatching char option is cleared, don't continue
2952  if {!$data($win,config,-matchaudit)} {
2953  return
2954  }
2955 
2956  # We don't have support for bracket auditing in embedded languages as of yet
2957  set lang ""
2958 
2959  # If a string was supplied, only perform bracket check for brackets found in string
2960  if {$str ne ""} {
2961  if {[info exists data($win,config,matchChar,$lang,curly)] && ([string map {\{ {} \} {} \\ {}} $str] ne $str)} { checkBracketType $win curly}
2962  if {[info exists data($win,config,matchChar,$lang,square)] && ([string map {\[ {} \] {} \\ {}} $str] ne $str)} { checkBracketType $win square}
2963  if {[info exists data($win,config,matchChar,$lang,paren)] && ([string map {( {} ) {} \\ {}} $str] ne $str)} { checkBracketType $win paren}
2964  if {[info exists data($win,config,matchChar,$lang,angled)] && ([string map {< {} > {} \\ {}} $str] ne $str)} { checkBracketType $win angled}
2965 
2966  # Otherwise, check all of the brackets
2967  } else {
2968  foreach type [list square curly paren angled] {
2969  if {[info exists data($win,config,matchChar,$lang,$type)]} {
2970  checkBracketType $win $type
2971  }
2972  }
2973  }
2974 
2975  }

§ checkBracketType()

ctext::checkBracketType   win stype  

Definition at line 2977 of file ctext.tcl.

2977  proc checkBracketType {win stype} {
2978 
2979  variable data
2980 
2981  # Clear missing
2982  $win._t tag remove missing:$stype 1.0 end
2983 
2984  set count 0
2985  set other ${stype}R
2986  set olist [lassign [$win.t tag ranges __$other] ofirst olast]
2987  set missing [list]
2988 
2989  # Perform count for all code containing left stypes
2990  foreach {sfirst slast} [$win.t tag ranges __${stype}L] {
2991  while {($ofirst ne "") && [$win.t compare $sfirst > $ofirst]} {
2992  if {[incr count -[$win._t count -chars $ofirst $olast]] < 0} {
2993  lappend missing "$olast+${count}c" $olast
2994  set count 0
2995  }
2996  set olist [lassign $olist ofirst olast]
2997  }
2998  if {$count == 0} {
2999  set start $sfirst
3000  }
3001  incr count [$win._t count -chars $sfirst $slast]
3002  }
3003 
3004  # Perform count for all right types after the above code
3005  while {$ofirst ne ""} {
3006  if {[incr count -[$win._t count -chars $ofirst $olast]] < 0} {
3007  lappend missing "$olast+${count}c" $olast
3008  set count 0
3009  }
3010  set olist [lassign $olist ofirst olast]
3011  }
3012 
3013  # Highlight all brackets that are missing right stypes
3014  while {$count > 0} {
3015  lappend missing $start "$start+1c"
3016  set start [getNextBracket $win ${stype}L $start]
3017  incr count -1
3018  }
3019 
3020  # Highlight all brackets that are missing left stypes
3021  catch { $win._t tag add missing:$stype {*}$missing}
3022 
3023  }

§ checkHighlightClass()

ctext::checkHighlightClass   win class  

Definition at line 3999 of file ctext.tcl.

3999  proc checkHighlightClass {win class} {
4000 
4001  variable data
4002 
4003  if {![info exists data($win,classopts,$class)]} {
4004  return -code error "Unspecified highlight class ($class) specified in [dict get [info frame -1] proc]"
4005  }
4006 
4007  }

§ clearCommentStringPatterns()

ctext::clearCommentStringPatterns   win  

Definition at line 3082 of file ctext.tcl.

3082  proc clearCommentStringPatterns {win} {
3083 
3084  variable data
3085 
3086  array unset data $win,config,csl_patterns,*
3087  array unset data $win,csl_char_tags,*
3088  array unset data $win,lc_char_tags,*
3089 
3090  set data($win,config,csl_array) [list]
3091  set data($win,config,csl_markers) [list]
3092  set data($win,config,csl_tag_pair) [list]
3093  set data($win,config,csl_tags) [list]
3094 
3095  }

§ command_append()

ctext::command_append   win args  

Definition at line 1415 of file ctext.tcl.

1415  proc command_append {win args} {
1416 
1417  variable data
1418 
1419  switch [llength $args] {
1420  1 -
1421  2 {
1422  catch { clipboard append -displayof $win [$win._t get {*}$args]}
1423  }
1424  default {
1425  catch { clipboard append -displayof $win [$win._t get sel.first sel.last]}
1426  }
1427  }
1428 
1429  }

§ command_cget()

ctext::command_cget   win args  

Definition at line 1431 of file ctext.tcl.

1431  proc command_cget {win args} {
1432 
1433  variable data
1434 
1435  set arg [lindex $args 0]
1436 
1437  foreach flag $data($win,config,ctextFlags) {
1438  if {[string match ${arg}* $flag]} {
1439  return [set data($win,config,$flag)]
1440  }
1441  }
1442 
1443  return [$win._t cget $arg]
1444 
1445  }

§ command_configure()

ctext::command_configure   win args  

Definition at line 1447 of file ctext.tcl.

1447  proc command_configure {win args} {
1448 
1449  variable data
1450 
1451  if {[llength $args] == 0} {
1452  set res [$win._t configure]
1453  foreach opt [list -xscrollcommand* -yscrollcommand* -autoseparators*] {
1454  set del [lsearch -glob $res $opt]
1455  set res [lreplace $res $del $del]
1456  }
1457  foreach flag $data($win,config,ctextFlags) {
1458  lappend res [list $flag [set data($win,config,$flag)]]
1459  }
1460  return $res
1461  }
1462 
1463  array set flags {}
1464  foreach flag $data($win,config,ctextFlags) {
1465  set loc [lsearch $args $flag]
1466  if {$loc < 0} {
1467  continue
1468  }
1469 
1470  if {[llength $args] <= ($loc + 1)} {
1471  return [list $flag [set data($win,config,$flag)]]
1472  }
1473 
1474  set flagArg [lindex $args [expr {$loc + 1}]]
1475  set args [lreplace $args $loc [expr {$loc + 1}]]
1476  set flags($flag) $flagArg
1477  }
1478 
1479  # Parse the argument list and process the value changes
1480  set update_linemap 0
1481  foreach {valueList flag cmd} $data($win,config,argTable) {
1482  if {[info exists flags($flag)]} {
1483  foreach valueToCheckFor $valueList {
1484  set value [set flags($flag)]
1485  if {[string equal "any" $valueToCheckFor]} $cmd \
1486  elseif {[string equal $valueToCheckFor [set flags($flag)]]} $cmd
1487  }
1488  }
1489  }
1490 
1491  # If we need to update the linemap, do it now
1492  if {$update_linemap} {
1493  linemapUpdate $win 1
1494  }
1495 
1496  if {[llength $args]} {
1497  uplevel 1 [linsert $args 0 $win._t configure]
1498  }
1499 
1500  }

§ command_copy()

ctext::command_copy   win args  

Definition at line 1502 of file ctext.tcl.

1502  proc command_copy {win args} {
1503 
1504  variable data
1505 
1506  # Get the start and end indices
1507  if {![catch {$win.t index sel.first} start_index]} {
1508  set end_index [$win.t index sel.last]
1509  } else {
1510  set start_index [$win.t index "insert linestart"]
1511  set end_index [$win.t index "insert+1l linestart"]
1512  }
1513 
1514  # Clear and copy the data to the clipboard
1515  clipboard clear -displayof $win.t
1516  clipboard append -displayof $win.t [$win.t get $start_index $end_index]
1517 
1518  }

§ command_cut()

ctext::command_cut   win args  

Definition at line 1520 of file ctext.tcl.

1520  proc command_cut {win args} {
1521 
1522  variable data
1523 
1524  # Get the start and end indices
1525  if {![catch {$win.t index sel.first} start_index]} {
1526  set end_index [$win.t index sel.last]
1527  } else {
1528  set start_index [$win.t index "insert linestart"]
1529  set end_index [$win.t index "insert+1l linestart"]
1530  }
1531 
1532  # Clear and copy the data to the clipboard
1533  clipboard clear -displayof $win.t
1534  clipboard append -displayof $win.t [$win.t get $start_index $end_index]
1535 
1536  # Delete the text
1537  $win delete $start_index $end_index
1538 
1539  }

§ command_delete()

ctext::command_delete   win args  

Definition at line 1541 of file ctext.tcl.

1541  proc command_delete {win args} {
1542 
1543  variable data
1544 
1545  set moddata [list]
1546  if {[lindex $args 0] eq "-moddata"} {
1547  set args [lassign $args dummy moddata]
1548  }
1549 
1550  set startPos [$win._t index [lindex $args 0]]
1551  if {[llength $args] == 1} {
1552  set endPos [$win._t index $startPos+1c]
1553  } else {
1554  set endPos [$win._t index [lindex $args 1]]
1555  }
1556  set ranges [list [$win._t index "$startPos linestart"] [$win._t index "$startPos lineend"]]
1557  set deldata [$win._t get $startPos $endPos]
1558  set do_tags [list]
1559 
1560  undo_delete $win $startPos $endPos
1561  handleDeleteAt0 $win $startPos $endPos
1562  linemapCheckOnDelete $win $startPos $endPos
1563  comments_chars_deleted $win $startPos $endPos do_tags
1564 
1565  $win._t delete $startPos $endPos
1566 
1567  if {[highlightAll $win $ranges 0 $do_tags]} {
1568  checkAllBrackets $win
1569  } else {
1570  checkAllBrackets $win $deldata
1571  }
1572  modified $win 1 [list delete $ranges $moddata]
1573 
1574  event generate $win.t <<CursorChanged>>
1575 
1576  }

§ command_diff()

ctext::command_diff   win args  

Definition at line 1578 of file ctext.tcl.

1578  proc command_diff {win args} {
1579 
1580  variable data
1581 
1582  set args [lassign $args subcmd]
1583  if {!$data($win,config,-diff_mode)} {
1584  return -code error "diff $subcmd called when -diff_mode is false"
1585  }
1586  switch -glob $subcmd {
1587  add {
1588  if {[llength $args] != 2} {
1589  return -code error "diff add takes two arguments: startline linecount"
1590  }
1591 
1592  lassign $args tline count
1593 
1594  # Get the current diff:A tag
1595  set tag [lsearch -inline -glob [$win._t tag names $tline.0] diff:A:*]
1596 
1597  # Get the beginning and ending position
1598  lassign [$win._t tag ranges $tag] start_pos end_pos
1599 
1600  # Get the line number embedded in the tag
1601  set fline [expr [lindex [split $tag :] 3] + [$win._t count -lines $start_pos $tline.0]]
1602 
1603  # Replace the diff:B tag
1604  $win._t tag remove $tag $tline.0 $end_pos
1605 
1606  # Add new tags
1607  set pos [$win._t index "$tline.0+${count}l linestart"]
1608  $win._t tag add diff:A:D:$fline $tline.0 $pos
1609  $win._t tag add diff:A:S:$fline $pos $end_pos
1610 
1611  # Colorize the *D* tag
1612  $win._t tag configure diff:A:D:$fline -background $data($win,config,-diffaddbg)
1613  $win._t tag lower diff:A:D:$fline _invisible
1614  }
1615  line {
1616  if {[llength $args] != 2} {
1617  return -code error "diff line takes two arguments: txtline type"
1618  }
1619  if {[set type_index [lsearch [list add sub] [lindex $args 1]]] == -1} {
1620  return -code error "diff line second argument must be add or sub"
1621  }
1622  set tag [lsearch -inline -glob [$win._t tag names [lindex $args 0].0] diff:[lindex [list B A] $type_index]:*]
1623  lassign [split $tag :] dummy index type line
1624  if {$type eq "S"} {
1625  incr line [$win._t count -lines [lindex [$win._t tag ranges $tag] 0] [lindex $args 0].0]
1626  }
1627  return $line
1628  }
1629  ranges {
1630  if {[llength $args] != 1} {
1631  return -code error "diff ranges takes one argument: type"
1632  }
1633  if {[lsearch [list add sub both] [lindex $args 0]] == -1} {
1634  return -code error "diff ranges argument must be add, sub or both"
1635  }
1636  set ranges [list]
1637  if {[lsearch [list add both] [lindex $args 0]] != -1} {
1638  foreach tag [lsearch -inline -all -glob [$win._t tag names] diff:A:D:*] {
1639  lappend ranges {*}[$win._t tag ranges $tag]
1640  }
1641  }
1642  if {[lsearch [list sub both] [lindex $args 0]] != -1} {
1643  foreach tag [lsearch -inline -all -glob [$win._t tag names] diff:B:D:*] {
1644  lappend ranges {*}[$win._t tag ranges $tag]
1645  }
1646  }
1647  return [lsort -dictionary $ranges]
1648  }
1649  reset {
1650  foreach name [lsearch -inline -all -glob [$win._t tag names] diff:*] {
1651  lassign [split $name :] dummy which type
1652  if {($which eq "B") && ($type eq "D") && ([llength [set ranges [$win._t tag ranges $name]]] > 0)} {
1653  $win._t delete {*}$ranges
1654  }
1655  $win._t tag delete $name
1656  }
1657  $win._t tag add diff:A:S:1 1.0 end
1658  $win._t tag add diff:B:S:1 1.0 end
1659  }
1660  sub {
1661  if {[llength $args] != 3} {
1662  return -code error "diff sub takes three arguments: startline linecount str"
1663  }
1664 
1665  lassign $args tline count str
1666 
1667  # Get the current diff: tags
1668  set tagA [lsearch -inline -glob [$win._t tag names $tline.0] diff:A:*]
1669  set tagB [lsearch -inline -glob [$win._t tag names $tline.0] diff:B:*]
1670 
1671  # Get the beginning and ending positions
1672  lassign [$win._t tag ranges $tagA] start_posA end_posA
1673  lassign [$win._t tag ranges $tagB] start_posB end_posB
1674 
1675  # Get the line number embedded in the tag
1676  set fline [expr [lindex [split $tagB :] 3] + [$win._t count -lines $start_posB $tline.0]]
1677 
1678  # Remove the diff: tags
1679  $win._t tag remove $tagA $start_posA $end_posA
1680  $win._t tag remove $tagB $start_posB $end_posB
1681 
1682  # Calculate the end position of the change
1683  set pos [$win._t index "$tline.0+${count}l linestart"]
1684 
1685  # Insert the string and highlight it
1686  $win._t insert $tline.0 $str
1687  $win highlight -insert 1 $tline.0 $pos
1688 
1689  # Add the tags
1690  $win._t tag add $tagA $start_posA [$win._t index "$end_posA+${count}l linestart"]
1691  $win._t tag add $tagB $start_posB $tline.0
1692  $win._t tag add diff:B:D:$fline $tline.0 $pos
1693  $win._t tag add diff:B:S:$fline $pos [$win._t index "$end_posB+${count}l linestart"]
1694 
1695  # Colorize the *D* tag
1696  $win._t tag configure diff:B:D:$fline -background $data($win,config,-diffsubbg)
1697  $win._t tag lower diff:B:D:$fline _invisible
1698  }
1699  }
1700  linemapUpdate $win 1
1701 
1702  }

§ command_edit()

ctext::command_edit   win args  

Definition at line 2374 of file ctext.tcl.

2374  proc command_edit {win args} {
2375 
2376  variable data
2377 
2378  switch [lindex $args 0] {
2379  modified {
2380  switch [llength $args] {
2381  1 {
2382  return $data($win,config,modified)
2383  }
2384  2 {
2385  set value [lindex $args 1]
2386  set data($win,config,modified) $value
2387  }
2388  default {
2389  return -code error "invalid arg(s) to $win edit modified: $args"
2390  }
2391  }
2392  }
2393  undo {
2394  undo $win
2395  }
2396  redo {
2397  redo $win
2398  }
2399  undoable {
2400  return [expr $data($win,config,undo_hist_size) > 0]
2401  }
2402  redoable {
2403  return [expr [llength $data($win,config,redo_hist)] > 0]
2404  }
2405  separator {
2406  if {[llength $data($win,config,undo_hist)] > 0} {
2407  undo_separator $win
2408  }
2409  }
2410  undocount {
2411  if {$data($win,config,undo_hist_size) == 0} {
2412  return 0
2413  } else {
2414  return [expr $data($win,config,undo_sep_count) + (([lindex $data($win,config,undo_hist) end 4] == 0) ? 1 : 0)]
2415  }
2416  }
2417  reset {
2418  set data($win,config,undo_hist) [list]
2419  set data($win,config,undo_hist_size) 0
2420  set data($win,config,undo_sep_next) -1
2421  set data($win,config,undo_sep_last) -1
2422  set data($win,config,undo_sep_size) 0
2423  set data($win,config,undo_sep_count) 0
2424  set data($win,config,redo_hist) [list]
2425  set data($win,config,modified) false
2426  }
2427  cursorhist {
2428  return [undo_get_cursor_hist $win]
2429  }
2430  default {
2431  return [uplevel 1 [linsert $args 0 $win._t $cmd]]
2432  }
2433  }
2434 
2435  }

§ command_fastdelete()

ctext::command_fastdelete   win args  

Definition at line 1704 of file ctext.tcl.

1704  proc command_fastdelete {win args} {
1705 
1706  variable data
1707 
1708  set moddata [list]
1709  set do_update 1
1710  set do_undo 1
1711  while {[string index [lindex $args 0] 0] eq "-"} {
1712  switch [lindex $args 0] {
1713  "-moddata" { set args [lassign $args dummy moddata]}
1714  "-update" { set args [lassign $args dummy do_update]}
1715  "-undo" { set args [lassign $args dummy do_undo]}
1716  }
1717  }
1718 
1719  if {[llength $args] == 1} {
1720  set startPos [$win._t index [lindex $args 0]]
1721  set endPos [$win._t index "$startPos+1c"]
1722  linemapCheckOnDelete $win $startPos
1723  } else {
1724  set startPos [$win._t index [lindex $args 0]]
1725  set endPos [$win._t index [lindex $args 1]]
1726  linemapCheckOnDelete $win $startPos $endPos
1727  }
1728 
1729  if {$do_undo} {
1730  undo_delete $win $startPos $endPos
1731  }
1732  handleDeleteAt0 $win $startPos $endPos
1733 
1734  $win._t delete {*}$args
1735 
1736  if {$do_update} {
1737  modified $win 1 [list delete [list $startPos $endPos] $moddata]
1738  event generate $win.t <<CursorChanged>>
1739  }
1740 
1741  }

§ command_fastinsert()

ctext::command_fastinsert   win args  

Definition at line 1743 of file ctext.tcl.

1743  proc command_fastinsert {win args} {
1744 
1745  variable data
1746 
1747  set moddata [list]
1748  set do_update 1
1749  set do_undo 1
1750  while {[string index [lindex $args 0] 0] eq "-"} {
1751  switch [lindex $args 0] {
1752  "-moddata" { set args [lassign $args dummy moddata]}
1753  "-update" { set args [lassign $args dummy do_update]}
1754  "-undo" { set args [lassign $args dummy do_undo]}
1755  }
1756  }
1757 
1758  set startPos [$win._t index [lindex $args 0]]
1759  set chars [string length [lindex $args 1]]
1760  set cursor [$win._t index insert]
1761 
1762  $win._t insert {*}$args
1763 
1764  set endPos [$win._t index "$startPos+${chars}c"]
1765 
1766  if {$do_undo} {
1767  undo_insert $win $startPos $chars $cursor
1768  }
1769  handleInsertAt0 $win._t $startPos $chars
1770  set_rmargin $win $startPos $endPos
1771 
1772  if {$do_update} {
1773  modified $win 1 [list insert [list $startPos $endPos] $moddata]
1774  event generate $win.t <<CursorChanged>>
1775  }
1776 
1777  }

§ command_fastreplace()

ctext::command_fastreplace   win args  

Definition at line 1779 of file ctext.tcl.

1779  proc command_fastreplace {win args} {
1780 
1781  variable data
1782 
1783  if {[llength $args] < 3} {
1784  return -code error "please use at least 3 arguments to $win replace"
1785  }
1786 
1787  set moddata [list]
1788  set do_update 1
1789  set do_undo 1
1790  while {[string index [lindex $args 0] 0] eq "-"} {
1791  switch [lindex $args 0] {
1792  "-moddata" { set args [lassign $args dummy moddata]}
1793  "-update" { set args [lassign $args dummy do_update]}
1794  "-undo" { set args [lassign $args dummy do_undo]}
1795  }
1796  }
1797 
1798  set startPos [$win._t index [lindex $args 0]]
1799  set endPos [$win._t index [lindex $args 1]]
1800  set datlen [string length [lindex $args 2]]
1801  set cursor [$win._t index insert]
1802 
1803  if {$do_undo} {
1804  undo_delete $win $startPos $endPos
1805  }
1806 
1807  set tags [handleReplaceDeleteAt0 $win $startPos $endPos]
1808 
1809  # Perform the text replacement
1810  $win._t replace {*}$args
1811 
1812  handleReplaceInsert $win $startPos $datlen $tags
1813  set_rmargin $win $startPos [$win._t index "$startPos+${datlen}c"]
1814 
1815  if {$do_undo} {
1816  undo_insert $win $startPos $datlen $cursor
1817  }
1818 
1819  if {$do_update} {
1820  modified $win 1 [list replace [list $startPos $endPos] $moddata]
1821  event generate $win.t <<CursorChanged>>
1822  }
1823 
1824  }

§ command_gutter()

ctext::command_gutter   win args  

Definition at line 2437 of file ctext.tcl.

2437  proc command_gutter {win args} {
2438 
2439  variable data
2440 
2441  set args [lassign $args subcmd]
2442  switch -glob $subcmd {
2443  create {
2444  set value_list [lassign $args gutter_name]
2445  set gutter_tags [list]
2446  foreach {name opts} $value_list {
2447  array set sym_opts $opts
2448  set sym [expr {[info exists sym_opts(-symbol)] ? $sym_opts(-symbol) : ""}]
2449  set gutter_tag "gutter:$gutter_name:$name:$sym"
2450  if {[info exists sym_opts(-fg)]} {
2451  set data($win,gutterfg,$gutter_tag) $sym_opts(-fg)
2452  }
2453  if {[info exists sym_opts(-onenter)]} {
2454  $win.l bind $gutter_tag <Enter> [list ctext::execute_gutter_cmd $win %y $sym_opts(-onenter)]
2455  }
2456  if {[info exists sym_opts(-onleave)]} {
2457  $win.l bind $gutter_tag <Leave> [list ctext::execute_gutter_cmd $win %y $sym_opts(-onleave)]
2458  }
2459  if {[info exists sym_opts(-onclick)]} {
2460  $win.l bind $gutter_tag <Button-1> [list ctext::execute_gutter_cmd $win %y $sym_opts(-onclick)]
2461  }
2462  if {[info exists sym_opts(-onshiftclick)]} {
2463  $win.l bind $gutter_tag <Shift-Button-1> [list ctext::execute_gutter_cmd $win %y $sym_opts(-onshiftclick)]
2464  }
2465  if {[info exists sym_opts(-oncontrolclick)]} {
2466  $win.l bind $gutter_tag <Control-Button-1> [list ctext::execute_gutter_cmd $win %y $sym_opts(-oncontrolclick)]
2467  }
2468  lappend gutter_tags $gutter_tag
2469  array unset sym_opts
2470  }
2471  lappend data($win,config,gutters) [list $gutter_name $gutter_tags 0]
2472  linemapUpdate $win 1
2473  }
2474  destroy {
2475  set gutter_name [lindex $args 0]
2476  if {[set index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] != -1} {
2477  $win._t tag delete {*}[lindex $data($win,config,gutters) $index 1]
2478  set data($win,config,gutters) [lreplace $data($win,config,gutters) $index $index]
2479  array unset data $win,gutterfg,gutter:$gutter_name:*
2480  linemapUpdate $win 1
2481  }
2482  }
2483  hide {
2484  set gutter_name [lindex $args 0]
2485  if {[set index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] != -1} {
2486  if {[llength $args] == 1} {
2487  return [lindex $data($win,config,gutters) $index 2]
2488  } else {
2489  lset data($win,config,gutters) $index 2 [lindex $args 1]
2490  linemapUpdate $win 1
2491  }
2492  } elseif {[llength $args] == 1} {
2493  return -code error "Unable to find gutter name ($gutter_name)"
2494  }
2495  }
2496  del* {
2497  lassign $args gutter_name sym_list
2498  set update_needed 0
2499  if {[set gutter_index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] == -1} {
2500  return -code error "Unable to find gutter name ($gutter_name)"
2501  }
2502  foreach symname $sym_list {
2503  set gutters [lindex $data($win,config,gutters) $gutter_index 1]
2504  if {[set index [lsearch -glob $gutters "gutter:$gutter_name:$symname:*"]] != -1} {
2505  $win._t tag delete [lindex $gutters $index]
2506  set gutters [lreplace $gutters $index $index]
2507  array unset data $win,gutterfg,gutter:$gutter_name:$symname:*
2508  lset data($win,config,gutters) $gutter_index 1 $gutters
2509  set update_needed 1
2510  }
2511  }
2512  if {$update_needed} {
2513  linemapUpdate $win 1
2514  }
2515  }
2516  set {
2517  set args [lassign $args gutter_name]
2518  set update_needed 0
2519  if {[set gutter_index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] != -1} {
2520  foreach {name line_nums} $args {
2521  if {[set gutter_tag [lsearch -inline -glob [lindex $data($win,config,gutters) $gutter_index 1] gutter:$gutter_name:$name:*]] ne ""} {
2522  foreach line_num $line_nums {
2523  if {[set curr_tag [lsearch -inline -glob [$win._t tag names $line_num.0] gutter:$gutter_name:*]] ne ""} {
2524  if {$curr_tag ne $gutter_tag} {
2525  $win._t tag delete $curr_tag
2526  $win._t tag add $gutter_tag $line_num.0
2527  set update_needed 1
2528  }
2529  } else {
2530  $win._t tag add $gutter_tag $line_num.0
2531  set update_needed 1
2532  }
2533  }
2534  }
2535  }
2536  }
2537  if {$update_needed} {
2538  linemapUpdate $win 1
2539  }
2540  }
2541  get {
2542  if {[llength $args] == 1} {
2543  set gutter_name [lindex $args 0]
2544  set symbols [list]
2545  if {[set gutter_index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] != -1} {
2546  foreach gutter_tag [lindex $data($win,config,gutters) $gutter_index 1] {
2547  set lines [list]
2548  foreach {first last} [$win._t tag ranges $gutter_tag] {
2549  lappend lines [lindex [split $first .] 0]
2550  }
2551  lappend symbols [lindex [split $gutter_tag :] 2] $lines
2552  }
2553  }
2554  return $symbols
2555  } elseif {[llength $args] == 2} {
2556  set gutter_name [lindex $args 0]
2557  if {[string is integer [lindex $args 1]]} {
2558  set line_num [lindex $args 1]
2559  if {[set tag [lsearch -inline -glob [$win._t tag names $line_num.0] gutter:$gutter_name:*]] ne ""} {
2560  return [lindex [split $tag :] 2]
2561  } else {
2562  return ""
2563  }
2564  } else {
2565  set lines [list]
2566  if {[set tag [lsearch -inline -glob [$win._t tag names] gutter:$gutter_name:[lindex $args 1]:*]] ne ""} {
2567  foreach {first last} [$win._t tag ranges $tag] {
2568  lappend lines [lindex [split $first .] 0]
2569  }
2570  }
2571  return $lines
2572  }
2573  }
2574  }
2575  clear {
2576  set last [lassign $args gutter_name first]
2577  if {[set gutter_index [lsearch -index 0 $data($win,config,gutters) $gutter_name]] != -1} {
2578  if {$last eq ""} {
2579  foreach gutter_tag [lindex $data($win,config,gutters) $gutter_index 1] {
2580  $win._t tag remove $gutter_tag $first.0
2581  }
2582  } else {
2583  foreach gutter_tag [lindex $data($win,config,gutters) $gutter_index 1] {
2584  $win._t tag remove $gutter_tag $first.0 [$win._t index $last.0+1c]
2585  }
2586  }
2587  linemapUpdate $win 1
2588  }
2589  }
2590  cget {
2591  lassign $args gutter_name sym_name opt
2592  if {[set index [lsearch -exact -index 0 $data($win,config,gutters) $gutter_name]] == -1} {
2593  return -code error "Unable to find gutter name ($gutter_name)"
2594  }
2595  if {[set gutter_tag [lsearch -inline -glob [lindex $data($win,config,gutters) $index 1] "gutter:$gutter_name:$sym_name:*"]] eq ""} {
2596  return -code error "Unknown symbol ($sym_name) specified"
2597  }
2598  switch $opt {
2599  -symbol { return [lindex [split $gutter_tag :] 3]}
2600  -fg { return [expr {[info exists data($win,gutterfg,$gutter_tag)] ? $data($win,gutterfg,$gutter_tag) : ""}]}
2601  -onenter { return [lrange [$win.l bind $gutter_tag <Enter>] 0 end-1]}
2602  -onleave { return [lrange [$win.l bind $gutter_tag <Leave>] 0 end-1]}
2603  -onclick { return [lrange [$win.l bind $gutter_tag <Button-1>] 0 end-1]}
2604  -onshiftclick { return [lrange [$win.l bind $gutter_tag <Shift-Button-1>] 0 end-1]}
2605  -oncontrolclick { return [lrange [$win.l bind $gutter_tag <Control-Button-1>] 0 end-1]}
2606  default {
2607  return -code error "Unknown gutter option ($opt) specified"
2608  }
2609  }
2610  }
2611  conf* {
2612  set args [lassign $args gutter_name]
2613  if {[set index [lsearch -exact -index 0 $data($win,config,gutters) $gutter_name]] == -1} {
2614  return -code error "Unable to find gutter name ($gutter_name)"
2615  }
2616  if {[llength $args] < 2} {
2617  if {[llength $args] == 0} {
2618  set match_tag "gutter:$gutter_name:*"
2619  } else {
2620  set match_tag "gutter:$gutter_name:[lindex $args 0]:*"
2621  }
2622  foreach gutter_tag [lsearch -inline -all -glob [lindex $data($win,config,gutters) $index 1] $match_tag] {
2623  lassign [split $gutter_tag :] dummy1 dummy2 symname sym
2624  set symopts [list]
2625  if {$sym ne ""} {
2626  lappend symopts -symbol $sym
2627  }
2628  if {[info exists data($win,gutterfg,$gutter_tag)]} {
2629  lappend symopts -fg $data($win,gutterfg,$gutter_tag)
2630  }
2631  if {[set cmd [lrange [$win.l bind $gutter_tag <Enter>] 0 end-1]] ne ""} {
2632  lappend symopts -onenter $cmd
2633  }
2634  if {[set cmd [lrange [$win.l bind $gutter_tag <Leave>] 0 end-1]] ne ""} {
2635  lappend symopts -onleave $cmd
2636  }
2637  if {[set cmd [lrange [$win.l bind $gutter_tag <Button-1>] 0 end-1]] ne ""} {
2638  lappend symopts -onclick $cmd
2639  }
2640  if {[set cmd [lrange [$win.l bind $gutter_tag <Shift-Button-1>] 0 end-1]] ne ""} {
2641  lappend symopts -onshiftclick $cmd
2642  }
2643  if {[set cmd [lrange [$win.l bind $gutter_tag <Control-Button-1>] 0 end-1]] ne ""} {
2644  lappend symopts -oncontrolclick $cmd
2645  }
2646  lappend gutters $symname $symopts
2647  }
2648  return $gutters
2649  } else {
2650  set args [lassign $args symname]
2651  set update_needed 0
2652  if {[set gutter_tag [lsearch -inline -glob [lindex $data($win,config,gutters) $index 1] "gutter:$gutter_name:$symname:*"]] eq ""} {
2653  return -code error "Unable to find gutter symbol name ($symname)"
2654  }
2655  foreach {opt value} $args {
2656  switch -glob $opt {
2657  -sym* {
2658  set ranges [$win._t tag ranges $gutter_tag]
2659  set opts [$win._t tag configure $gutter_tag]
2660  $win._t tag delete $gutter_tag
2661  set gutter_tag "gutter:$gutter_name:$symname:$value"
2662  $win._t tag configure $gutter_tag {*}$opts
2663  $win._t tag add $gutter_tag {*}$ranges
2664  set update_needed 1
2665  }
2666  -fg {
2667  if {$value ne ""} {
2668  set data($win,gutterfg,$gutter_tag) $value
2669  } else {
2670  array unset data $win,gutterfg,$gutter_tag
2671  }
2672  set update_needed 1
2673  }
2674  -onenter {
2675  $win.l bind $gutter_tag <Enter> [list ctext::execute_gutter_cmd $win %y $value]
2676  }
2677  -onleave {
2678  $win.l bind $gutter_tag <Leave> [list ctext::execute_gutter_cmd $win %y $value]
2679  }
2680  -onclick {
2681  $win.l bind $gutter_tag <Button-1> [list ctext::execute_gutter_cmd $win %y $value]
2682  }
2683  -onshiftclick {
2684  $win.l bind $gutter_tag <Shift-Button-1> [list ctext::execute_gutter_cmd $win %y $value]
2685  }
2686  -oncontrolclick {
2687  $win.l bind $gutter_tag <Control-Button-1> [list ctext::execute_gutter_cmd $win %y $value]
2688  }
2689  default {
2690  return -code error "Unknown gutter option ($opt) specified"
2691  }
2692  }
2693  }
2694  if {$update_needed} {
2695  linemapUpdate $win 1
2696  }
2697  }
2698  }
2699  names {
2700  set names [list]
2701  foreach gutter $data($win,config,gutters) {
2702  lappend names [lindex $gutter 0]
2703  }
2704  return $names
2705  }
2706  }
2707 
2708  }

§ command_highlight()

ctext::command_highlight   win args  

Definition at line 1826 of file ctext.tcl.

1826  proc command_highlight {win args} {
1827 
1828  variable data
1829 
1830  set moddata [list]
1831  set insert 0
1832  set dotags ""
1833  set modified 0
1834  set ranges [list]
1835 
1836  while {[string index [lindex $args 0] 0] eq "-"} {
1837  switch [lindex $args 0] {
1838  "-moddata" { set args [lassign $args dummy moddata]}
1839  "-insert" { set args [lassign $args dummy insert]}
1840  "-dotags" { set args [lassign $args dummy dotags]}
1841  "-modified" { set args [lassign $args dummy]; set modified 1}
1842  default {
1843  return -code error "Unknown option specified ([lindex $args 0])"
1844  }
1845  }
1846  }
1847 
1848  foreach {start end} $args {
1849  lappend ranges [$win._t index "$start linestart"] [$win._t index "$end lineend"]
1850  }
1851 
1852  highlightAll $win $ranges $insert $dotags
1853  modified $win $modified [list highlight $ranges $moddata]
1854 
1855  }

§ command_insert()

ctext::command_insert   win args  

Definition at line 1857 of file ctext.tcl.

1857  proc command_insert {win args} {
1858 
1859  variable data
1860 
1861  if {[llength $args] < 2} {
1862  return -code error "please use at least 2 arguments to $win insert"
1863  }
1864 
1865  set moddata [list]
1866  if {[lindex $args 0] eq "-moddata"} {
1867  set args [lassign $args dummy moddata]
1868  }
1869 
1870  set insertPos [$win._t index [lindex $args 0]]
1871  set cursor [$win._t index insert]
1872  set dat ""
1873  set do_tags [list]
1874 
1875  if {[lindex $args 0] eq "end"} {
1876  set lineStart [$win._t index "$insertPos-1c linestart"]
1877  } else {
1878  set lineStart [$win._t index "$insertPos linestart"]
1879  }
1880 
1881  # Gather the data
1882  foreach {chars taglist} [lrange $args 1 end] {
1883  append dat $chars
1884  }
1885  set datlen [string length $dat]
1886 
1887  # Add the embedded language tag to the arguments if taglists are present
1888  if {([llength $args] >= 3) && ([set lang [getLang $win $insertPos]] ne "")} {
1889  set tag_index 2
1890  foreach {chars taglist} [lrange $args 1 end] {
1891  lappend taglist __Lang:$lang
1892  lset args $tag_index $taglist
1893  incr tag_index 2
1894  }
1895  }
1896 
1897  $win._t insert {*}$args
1898 
1899  set lineEnd [$win._t index "${insertPos}+${datlen}c lineend"]
1900 
1901  undo_insert $win $insertPos $datlen $cursor
1902  handleInsertAt0 $win._t $insertPos $datlen
1903  set_rmargin $win $insertPos "$insertPos+${datlen}c"
1904  comments_do_tag $win $insertPos "$insertPos+${datlen}c" do_tags
1905 
1906  # Highlight text and bracket auditing
1907  if {[highlightAll $win [list $lineStart $lineEnd] 1 $do_tags]} {
1908  checkAllBrackets $win
1909  } else {
1910  checkAllBrackets $win $dat
1911  }
1912  modified $win 1 [list insert [list $lineStart $lineEnd] $moddata]
1913 
1914  event generate $win.t <<CursorChanged>>
1915 
1916  }

§ command_is()

ctext::command_is   win args  

Definition at line 1919 of file ctext.tcl.

1919  proc command_is {win args} {
1920 
1921  if {[llength $args] < 2} {
1922  return -code error "Incorrect arguments passed to ctext is command"
1923  }
1924 
1925  lassign $args type extra index
1926 
1927  switch $type {
1928  escaped { return [isEscaped $win [$win._t index $extra]]}
1929  firstchar {
1930  set index [$win._t index $extra]
1931  set prewhite [$win._t tag prevrange __prewhite "$index+1c"]
1932  return [expr {($prewhite ne "") && [$win._t compare [lindex $prewhite 1] == "$index+1c"]}]
1933  }
1934  curly -
1935  square -
1936  paren -
1937  angled {
1938  if {[lsearch [list left right any] $extra] == -1} {
1939  set index [$win._t index $extra]
1940  set extra "any"
1941  } else {
1942  set index [$win._t index $index]
1943  }
1944  array set chars [list left L right R any *]
1945  return [expr [lsearch [$win._t tag names $index] __$type$chars($extra)] != -1]
1946  }
1947  double -
1948  single -
1949  btick -
1950  tripledouble -
1951  triplesingle -
1952  triplebtick {
1953  if {[lsearch [list left right any] $extra] == -1} {
1954  set index [$win._t index $extra]
1955  set extra "any"
1956  } else {
1957  set index [$win._t index $index]
1958  }
1959  array set chars [list double d single s btick b tripledouble D triplesingle S triplebtick B]
1960  return [isQuote $win $chars($type) $index $extra]
1961  }
1962  indent -
1963  unindent -
1964  reindent -
1965  reindentStart {
1966  return [expr [lsearch [$win._t tag names $extra] __$type] != -1]
1967  }
1968  insquare -
1969  incurly -
1970  inparen -
1971  inangled {
1972  if {$index ne ""} {
1973  upvar 2 $index range
1974  }
1975  return [inBlockRange $win [string range $type 2 end] $extra range]
1976  }
1977  indouble -
1978  insingle -
1979  inbtick -
1980  intripledouble -
1981  intriplesingle -
1982  intriplebtick -
1983  inblockcomment -
1984  inlinecomment -
1985  incomment -
1986  instring -
1987  incommentstring {
1988  array set procs {
1989  indouble DoubleQuote
1990  insingle SingleQuote
1991  inbtick BackTick
1992  intripledouble TripleDoubleQuote
1993  intriplesingle TripleSingleQuote
1994  intriplebtick TripleBackTick
1995  inblockcomment BlockComment
1996  inlinecomment LineComment
1997  incomment Comment
1998  instring String
1999  incommentstring CommentString
2000  }
2001  if {$index ne ""} {
2002  upvar 2 $index range
2003  return [in$procs($type)Range $win [$win._t index $extra] range]
2004  } else {
2005  return [in$procs($type) $win [$win._t index $extra]]
2006  }
2007  }
2008  inclass {
2009  if {$extra eq ""} {
2010  return -code error "Calling ctext is inclass without specifying a class name"
2011  }
2012  if {[lsearch -exact [$win._t tag names $extra] __$index] != -1} {
2013  set range [$win._t tag prevrange __$extra "[$win._t index $index]+1c"]
2014  return 1
2015  } else {
2016  return 0
2017  }
2018  }
2019  default {
2020  return -code error "Unsupported is command type specified"
2021  }
2022  }
2023 
2024  }

§ command_paste()

ctext::command_paste   win args  

Definition at line 2104 of file ctext.tcl.

2104  proc command_paste {win args} {
2105 
2106  variable data
2107 
2108  set moddata [list]
2109  if {[lindex $args 0] eq "-moddata"} {
2110  set args [lassign $args dummy moddata]
2111  }
2112 
2113  set insertPos [$win._t index insert]
2114  set datalen [string length [clipboard get]]
2115 
2116  tk_textPaste $win
2117 
2118  handleInsertAt0 $win._t $insertPos $datalen
2119  modified $win 1 [list insert [list $insertPos [$win._t index "$insertPos+${datalen}c"]] $moddata]
2120  event generate $win.t <<CursorChanged>>
2121 
2122  }

§ command_peer()

ctext::command_peer   win args  

Definition at line 2124 of file ctext.tcl.

2124  proc command_peer {win args} {
2125 
2126  variable data
2127 
2128  switch [lindex $args 0] {
2129  names {
2130  set names [list]
2131  foreach name [$win._t peer names] {
2132  lappend names [winfo parent $name]
2133  }
2134  return $names
2135  }
2136  default {
2137  return -code error "unknown peer subcommand: [lindex $args 0]"
2138  }
2139  }
2140 
2141  }

§ command_replace()

ctext::command_replace   win args  

Definition at line 2048 of file ctext.tcl.

2048  proc command_replace {win args} {
2049 
2050  variable data
2051 
2052  if {[llength $args] < 3} {
2053  return -code error "please use at least 3 arguments to $win replace"
2054  }
2055 
2056  set moddata [list]
2057  if {[lindex $args 0] eq "-moddata"} {
2058  set args [lassign $args dummy moddata]
2059  }
2060 
2061  set startPos [$win._t index [lindex $args 0]]
2062  set endPos [$win._t index [lindex $args 1]]
2063  set dat ""
2064  foreach {chars taglist} [lrange $args 2 end] {
2065  append dat $chars
2066  }
2067  set datlen [string length $dat]
2068  set deldata [$win._t get $startPos $endPos]
2069  set cursor [$win._t index insert]
2070  set do_tags [list]
2071 
2072  undo_delete $win $startPos $endPos
2073  comments_chars_deleted $win $startPos $endPos do_tags
2074  set tags [handleReplaceDeleteAt0 $win $startPos $endPos]
2075 
2076  # Perform the text replacement
2077  $win._t replace {*}$args
2078 
2079  handleReplaceInsert $win $startPos $datlen $tags
2080  undo_insert $win $startPos $datlen $cursor
2081 
2082  set lineStart [$win._t index "$startPos linestart"]
2083  set lineEnd [$win._t index "$startPos+[expr $datlen + 1]c lineend"]
2084 
2085  if {[llength $do_tags] == 0} {
2086  comments_do_tag $win $startPos "$startPos+${datlen}c" do_tags
2087  }
2088  set_rmargin $win $startPos "$startPos+${datlen}c"
2089 
2090  set comstr [highlightAll $win [list $lineStart $lineEnd] 1 $do_tags]
2091  if {$comstr == 2} {
2092  checkAllBrackets $win
2093  } elseif {$comstr == 1} {
2094  checkAllBrackets $win [$win._t get $startPos $lineEnd]
2095  } else {
2096  checkAllBrackets $win "$deldata$dat"
2097  }
2098  modified $win 1 [list replace [list $startPos $endPos] $moddata]
2099 
2100  event generate $win.t <<CursorChanged>>
2101 
2102  }

§ command_syntax()

ctext::command_syntax   win args  

Definition at line 2144 of file ctext.tcl.

2144  proc command_syntax {win args} {
2145 
2146  variable data
2147 
2148  set args [lassign $args subcmd]
2149 
2150  switch $subcmd {
2151  add { $win._t tag add __[lindex $args 0] {*}[lrange $args 1 end]}
2152  addclass { addHighlightClass $win {*}$args}
2153  addwords { addHighlightKeywords $win {*}$args}
2154  addregexp { addHighlightRegexp $win {*}$args}
2155  addcharstart { addHighlightWithOnlyCharStart $win {*}$args}
2156  addlinecomments { addLineCommentPatterns $win {*}$args}
2157  addblockcomments { addBlockCommentPatterns $win {*}$args}
2158  addstrings { addStringPatterns $win {*}$args}
2159  addembedlang { addEmbedLangPattern $win {*}$args}
2160  search { highlightSearch $win {*}$args}
2161  delete {
2162  switch [lindex $args 0] {
2163  class -
2164  classes {
2165  foreach class [lrange $args 1 end] {
2166  deleteHighlightClass $win $class
2167  }
2168  }
2169  command -
2170  commands {
2171  foreach command [lrange $args 1 end] {
2172  deleteHighlightCommand $win $command
2173  }
2174  }
2175  all {
2176  foreach class [getHighlightClasses $win] {
2177  deleteHighlightClass $win $class
2178  }
2179  deleteHighlightCommand $win *
2180  }
2181  default {
2182  return -code error "Unknown syntax delete specifier ([lindex $args 0])"
2183  }
2184  }
2185  }
2186  classes { return [getHighlightClasses $win {*}$args]}
2187  metaclasses { return $data($win,config,meta_classes)}
2188  clear {
2189  switch [llength $args] {
2190  0 {
2191  foreach class [getHighlightClasses $win] {
2192  $win tag remove __$class 1.0 end
2193  }
2194  }
2195  1 {
2196  $win tag remove __[lindex $args 0] 1.0 end
2197  }
2198  2 {
2199  foreach class [getHighlightClasses $win] {
2200  $win tag remove __$class {*}$args
2201  }
2202  }
2203  3 {
2204  $win tag remove __[lindex $args 0] {*}[lrange $args 1 end]
2205  }
2206  default {
2207  return -code error "Invalid arguments passed to syntax clear command"
2208  }
2209  }
2210  }
2211  contains { return [expr [lsearch [$win._t tag names [lindex $args 1]] __[lindex $args 0]] != -1]}
2212  nextrange { return [$win tag nextrange __[lindex $args 0] {*}[lrange $args 1 end]]}
2213  prevrange { return [$win tag prevrange __[lindex $args 0] {*}[lrange $args 1 end]]}
2214  ranges { return [$win tag ranges __[lindex $args 0]]}
2215  highlight {
2216  set i 0
2217  while {[string index [lindex $args $i] 0] eq "-"} { incr i 2}
2218  array set opts {
2219  -moddata {}
2220  -insert 0
2221  -dotags {}
2222  -modified 0
2223  }
2224  array set opts [lrange $args 0 [expr $i - 1]]
2225  set ranges [list]
2226  foreach {start end} [lrange $args $i end] {
2227  lappend ranges [$win._t index "$start linestart"] [$win._t index "$end lineend"]
2228  }
2229  highlightAll $win $ranges $opts(-insert) $opts(-dotags)
2230  modified $win $opts(-modified) [list highlight $ranges $opts(-moddata)]
2231  }
2232  configure { return [$win._t tag configure __[lindex $args 0] {*}[lrange $args 1 end]]}
2233  cget { return [$win._t tag cget __[lindex $args 0] {*}[lrange $args 1 end]]}
2234  default {
2235  return -code error [format "%s ($subcmd)" [msgcat::mc "Unknown ctext syntax subcommand"]]
2236  }
2237  }
2238 
2239  }

§ command_tag()

ctext::command_tag   win args  

Definition at line 2244 of file ctext.tcl.

2244  proc command_tag {win args} {
2245 
2246  variable range_cache
2247 
2248  set args [lassign $args subcmd]
2249 
2250  switch $subcmd {
2251  place {
2252  set args [lassign $args tag]
2253  if {[llength $args] == 0} {
2254  array set opts [$win._t tag configure $tag]
2255  if {$opts(-background) ne ""} {
2256  $win._t tag lower $tag _visibleH
2257  } elseif {($opts(-foreground) ne "") || ($opts(-font) ne "")} {
2258  $win._t tag lower $tag _visibleL
2259  } else {
2260  $win._t tag lower $tag _invisible
2261  }
2262  } else {
2263  switch [lindex $args 0] {
2264  visible1 { $win._t tag lower $tag _visibleH}
2265  visible2 { $win._t tag raise $tag _visibleL}
2266  visible3 { $win._t tag lower $tag _visibleL}
2267  visible4 { $win._t tag raise $tag _invisible}
2268  invisible { $win._t tag lower $tag _invisible}
2269  priority { $win._t tag raise $tag _visibleH}
2270  default { return -code error "Invalid tag place value ([lindex $args 0])"}
2271  }
2272  }
2273  }
2274  nextrange -
2275  prevrange {
2276  set args0 [set args1 [lassign $args tag]]
2277  set indent_tags [list __indent __unindent __reindent __reindentStart]
2278  set bracket_tags [list __curlyL __curlyR __squareL __squareR __parenL __parenR __angledL __angledR]
2279  if {[string map [list $tag {}] $indent_tags] ne $indent_tags} {
2280  if {$subcmd eq "nextrange"} {
2281  lassign [$win._t tag nextrange ${tag}0 {*}$args0] s0 e0
2282  while {($s0 ne "") && ([inCommentString $win $s0] || [isEscaped $win $s0])} {
2283  lset args0 0 $e0
2284  lassign [$win._t tag nextrange ${tag}0 {*}$args0] s0 e0
2285  }
2286  lassign [$win._t tag nextrange ${tag}1 {*}$args1] s1 e1
2287  while {($s1 ne "") && ([inCommentString $win $s1] || [isEscaped $win $s1])} {
2288  lset args1 0 $e1
2289  lassign [$win._t tag nextrange ${tag}0 {*}$args1] s1 e1
2290  }
2291  } else {
2292  lassign [$win._t tag prevrange ${tag}0 {*}$args0] s0 e0
2293  while {($s0 ne "") && ([inCommentString $win $s0] || [isEscaped $win $s0])} {
2294  lset args0 0 $s0
2295  lassign [$win._t tag prevrange ${tag}0 {*}$args0] s0 e0
2296  }
2297  lassign [$win._t tag prevrange ${tag}1 {*}$args1] s1 e1
2298  while {($s1 ne "") && ([inCommentString $win $s1] || [isEscaped $win $s1])} {
2299  lset args1 0 $s1
2300  lassign [$win._t tag prevrange ${tag}0 {*}$args1] s1 e1
2301  }
2302  }
2303  if {$s0 eq ""} {
2304  if {$s1 eq ""} {
2305  return ""
2306  } else {
2307  return [list $s1 $e1]
2308  }
2309  } else {
2310  if {$s1 eq ""} {
2311  return [list $s0 $e0]
2312  } else {
2313  if {[$win._t compare $s0 [expr {($subcmd eq "nextrange") ? "<" : ">"}] $s1]} {
2314  return [list $s0 $e0]
2315  } else {
2316  return [list $s1 $e1]
2317  }
2318  }
2319  }
2320  } elseif {[string map [list $tag {}] $bracket_tags] ne $bracket_tags} {
2321  if {$subcmd eq "nextrange"} {
2322  lassign [$win._t tag nextrange $tag {*}$args0] s e
2323  while {($s ne "") && ([inCommentString $win $s] || ([isEscaped $win $s] && ([$win._t index "$s+1c"] eq $e)))} {
2324  lset args0 0 $e
2325  lassign [$win._t tag nextrange $tag {*}$args0] s e
2326  }
2327  } else {
2328  lassign [$win._t tag prevrange $tag {*}$args0] s e
2329  if {($s ne "") && ![inCommentString $win $s] && [isEscaped $win $s] && [$win._t compare "$s+1c" == [lindex $args0 0]]} {
2330  lassign [$win._t tag prevrange $tag $s {*}[lrange $args0 1 end]] s e
2331  }
2332  while {($s ne "") && ([inCommentString $win $s] || ([isEscaped $win $s] && ([$win._t index "$s+1c"] eq $e)))} {
2333  lset args0 0 $s
2334  lassign [$win._t tag prevrange $tag {*}$args0] s e
2335  }
2336  }
2337  if {$s eq ""} {
2338  return ""
2339  } elseif {[isEscaped $win $s]} {
2340  return [list [$win._t index "$s+1c"] $e]
2341  } else {
2342  return [list $s $e]
2343  }
2344  } else {
2345  return [$win._t tag $subcmd $tag {*}$args0]
2346  }
2347  }
2348  ranges {
2349  set tag [lindex $args 0]
2350  set bracket_tags [list __curlyL __curlyR __squareL __squareR __parenL __parenR __angledL __angledR]
2351  if {[string map [list $tag {}] $bracket_tags] ne $bracket_tags} {
2352  if {![info exists range_cache($win,$tag)]} {
2353  set range_cache($win,$tag) [list]
2354  foreach {s e} [$win._t tag ranges $tag] {
2355  if {![inCommentString $win $s]} {
2356  if {![isEscaped $win $s] || ([set s [$win._t index "$s+1c"]] ne $e)} {
2357  lappend range_cache($win,$tag) $s $e
2358  }
2359  }
2360  }
2361  }
2362  return $range_cache($win,$tag)
2363  } else {
2364  return [$win._t tag ranges $tag]
2365  }
2366  }
2367  default {
2368  return [$win._t tag $subcmd {*}$args]
2369  }
2370  }
2371 
2372  }

§ commentCharRanges()

ctext::commentCharRanges   win index  

Definition at line 792 of file ctext.tcl.

792  proc commentCharRanges {win index} {
793 
794  if {[set curr_tag [lsearch -inline -glob [$win tag names $index] __comstr1*]] ne ""} {
795  set range [$win tag prevrange $curr_tag $index+1c]
796  if {[string index $curr_tag 9] eq "l"} {
797  set start_tag [lsearch -inline -glob [$win tag names [lindex $range 0]] __lCommentStart:*]
798  lappend ranges {*}[$win tag prevrange $start_tag [lindex $range 0]+1c] [lindex $range 1]
799  } else {
800  set start_tag [lsearch -inline -glob [$win tag names [lindex $range 0]] __cCommentStart:*]
801  set end_tag [lsearch -inline -glob [$win tag names [lindex $range 1]-1c] __cCommentEnd:*]
802  lappend ranges {*}[$win tag prevrange $start_tag [lindex $range 0]+1c]
803  lappend ranges {*}[$win tag prevrange $end_tag [lindex $range 1]]
804  }
805  return $ranges
806  }
807 
808  return [list]
809 
810  }

§ comments()

ctext::comments   win ranges do_tags  

Definition at line 3389 of file ctext.tcl.

3389  proc comments {win ranges do_tags} {
3390 
3391  variable data
3392 
3393  array set tag_changed $do_tags
3394  set retval 0
3395 
3396  # Go through each language
3397  foreach lang $data($win,config,langs) {
3398 
3399  # If a csl_pattern does not exist for this language, go to the next language
3400  if {![info exists data($win,config,csl_patterns,$lang)]} continue
3401 
3402  # Get the ranges to check
3403  if {$lang eq ""} {
3404  set lranges [list 1.0 end]
3405  } else {
3406  set lranges [$win._t tag ranges "__Lang:$lang"]
3407  }
3408 
3409  # Perform highlighting for each range
3410  foreach {langstart langend} $lranges {
3411 
3412  # Go through each range
3413  foreach {start end} $ranges {
3414 
3415  if {[$win._t compare $start > $langend] || [$win._t compare $langstart > $end]} continue
3416  if {[$win._t compare $start <= $langstart]} { set pstart $langstart} else { set pstart $start}
3417  if {[$win._t compare $langend <= $end]} { set pend $langend} else { set pend $end}
3418 
3419  set lines [split [$win._t get $pstart $pend] \n]
3420  set startrow [lindex [split $pstart .] 0]
3421 
3422  # First, tag all string/comment patterns found between start and end
3423  foreach {tag1 tag2 pattern} $data($win,config,csl_patterns,$lang) {
3424  array set indices [list ${tag1}0 {} ${tag1}1 {}]
3425  if {$tag2 ne ""} {
3426  array set indices [list ${tag2}0 {} ${tag2}1 {}]
3427  }
3428  set i 0
3429  set row $startrow
3430  foreach line $lines {
3431  set col 0
3432  while {[regexp -indices -start $col {*}$data($win,config,re_opts) -- $pattern $line -> sres tres]} {
3433  lassign $sres scol ecol
3434  set tag $tag1
3435  if {$scol == -1} {
3436  lassign $tres scol ecol
3437  set tag $tag2
3438  }
3439  set col [expr $ecol + 1]
3440  if {![isEscaped $win $row.$scol]} {
3441  if {([string index $pattern 0] eq "^") && ([string index $tag 2] ne "L")} {
3442  set match [string range $line $scol $ecol]
3443  set diff [expr [string length $match] - [string length [string trimleft $match]]]
3444  lappend indices($tag[expr $i & 1]) $row.[expr $scol + $diff] $row.$col
3445  } else {
3446  lappend indices($tag[expr $i & 1]) $row.$scol $row.$col
3447  }
3448  }
3449  incr i
3450  }
3451  incr row
3452  }
3453  foreach tag [array names indices] {
3454  if {$indices($tag) ne [getTagInRange $win $tag $pstart $pend]} {
3455  $win._t tag remove $tag $pstart $pend
3456  catch { $win._t tag add $tag {*}$indices($tag)}
3457  set tag_changed([string range $tag 0 end-1]) 1
3458  }
3459  }
3460  array unset indices
3461  }
3462 
3463  }
3464 
3465  # If we didn't find any comment/string characters that changed, no need to continue.
3466  if {[array size tag_changed] == 0} continue
3467 
3468  # Initialize tags
3469  array unset tags
3470  set char_tags [list]
3471 
3472  # Gather the list of comment ranges in the char_tags list
3473  foreach i {0 1} {
3474  if {[info exists data($win,config,lc_char_tags,$lang)]} {
3475  foreach char_tag $data($win,config,lc_char_tags,$lang) {
3476  set index $langstart
3477  while {([set char_end [lassign [$win tag nextrange $char_tag$i $index] char_start]] ne "") && [$win compare $char_end <= $langend]} {
3478  set lineend [$win index "$char_start lineend"]
3479  set index $lineend
3480  lappend char_tags [list $char_start $char_end __lCommentStart:$lang] [list ${lineend}a "$lineend+1c" __lCommentEnd:$lang]
3481  }
3482  }
3483  }
3484  if {[info exists data($win,config,csl_char_tags,$lang)]} {
3485  foreach char_tag $data($win,config,csl_char_tags,$lang) {
3486  set index $langstart
3487  while {([set char_end [lassign [$win tag nextrange $char_tag$i $index] char_start]] ne "") && [$win compare $char_end <= $langend]} {
3488  lappend char_tags [list $char_start $char_end $char_tag]
3489  set index $char_end
3490  }
3491  }
3492  }
3493  }
3494 
3495  # Sort the char tags
3496  set char_tags [lsort -dictionary -index 0 $char_tags]
3497 
3498  # Create the tag lists
3499  set curr_lang $lang
3500  set curr_lang_start ""
3501  set curr_char_tag ""
3502  set rb 0
3503  array set tag_pairs $data($win,config,csl_tag_pair)
3504  foreach char_info $char_tags {
3505  lassign $char_info char_start char_end char_tag
3506  if {($curr_char_tag eq "") || [string match "__*End:$curr_lang" $curr_char_tag] || ($char_tag eq "__LangEnd:$curr_lang")} {
3507  if {[string range $char_tag 0 6] eq "__LangS"} {
3508  set curr_lang [lindex [split $char_tag :] 1]
3509  set curr_lang_start $char_start
3510  set curr_char_tag ""
3511  } elseif {$char_tag eq "__LangEnd:$curr_lang"} {
3512  if {[info exists tag_pairs($curr_char_tag)]} {
3513  lappend tags($tag_pairs($curr_char_tag)$rb) $curr_char_start $char_start
3514  set rb [expr $rb ^ 1]
3515  }
3516  if {$curr_lang_start ne ""} {
3517  lappend tags(__Lang:$curr_lang) $curr_lang_start $char_end
3518  }
3519  set curr_lang ""
3520  set curr_lang_start ""
3521  set curr_char_tag ""
3522  } elseif {[string match "*:$curr_lang" $char_tag]} {
3523  set curr_char_tag $char_tag
3524  set curr_char_start $char_start
3525  }
3526  } elseif {$curr_char_tag eq "__lCommentStart:$curr_lang"} {
3527  if {$char_tag eq "__lCommentEnd:$curr_lang"} {
3528  lappend tags(__comstr1l) $curr_char_start $char_end
3529  set curr_char_tag ""
3530  }
3531  } elseif {$curr_char_tag eq "__cCommentStart:$curr_lang"} {
3532  if {$char_tag eq "__cCommentEnd:$curr_lang"} {
3533  lappend tags(__comstr1c$rb) $curr_char_start $char_end
3534  set curr_char_tag ""
3535  set rb [expr $rb ^ 1]
3536  }
3537  } elseif {$curr_char_tag eq "__dQuote:$curr_lang"} {
3538  if {$char_tag eq "__dQuote:$curr_lang"} {
3539  lappend tags(__comstr0d$rb) $curr_char_start $char_end
3540  set curr_char_tag ""
3541  set rb [expr $rb ^ 1]
3542  }
3543  } elseif {$curr_char_tag eq "__sQuote:$curr_lang"} {
3544  if {$char_tag eq "__sQuote:$curr_lang"} {
3545  lappend tags(__comstr0s$rb) $curr_char_start $char_end
3546  set curr_char_tag ""
3547  set rb [expr $rb ^ 1]
3548  }
3549  } elseif {$curr_char_tag eq "__bQuote:$curr_lang"} {
3550  if {$char_tag eq "__bQuote:$curr_lang"} {
3551  lappend tags(__comstr0b$rb) $curr_char_start $char_end
3552  set curr_char_tag ""
3553  set rb [expr $rb ^ 1]
3554  }
3555  } elseif {$curr_char_tag eq "__DQuote:$curr_lang"} {
3556  if {$char_tag eq "__DQuote:$curr_lang"} {
3557  lappend tags(__comstr0D$rb) $curr_char_start $char_end
3558  set curr_char_tag ""
3559  set rb [expr $rb ^ 1]
3560  }
3561  } elseif {$curr_char_tag eq "__SQuote:$curr_lang"} {
3562  if {$char_tag eq "__SQuote:$curr_lang"} {
3563  lappend tags(__comstr0S$rb) $curr_char_start $char_end
3564  set curr_char_tag ""
3565  set rb [expr $rb ^ 1]
3566  }
3567  } elseif {$curr_char_tag eq "__BQuote:$curr_lang"} {
3568  if {$char_tag eq "__BQuote:$curr_lang"} {
3569  lappend tags(__comstr0B$rb) $curr_char_start $char_end
3570  set curr_char_tag ""
3571  set rb [expr $rb ^ 1]
3572  }
3573  }
3574  }
3575  if {[info exists tag_pairs($curr_char_tag)]} {
3576  lappend tags($tag_pairs($curr_char_tag)$rb) $curr_char_start [expr {($lang eq "") ? "end" : "$langend linestart"}]
3577  }
3578  if {($curr_lang ne "") && ($lang eq "")} {
3579  lappend tags(__Lang:$curr_lang) $curr_lang_start end
3580  }
3581 
3582  # Delete old tags
3583  if {$lang eq ""} {
3584  foreach l $data($win,config,langs) {
3585  catch { $win._t tag remove __Lang:$l $langstart $langend}
3586  }
3587  }
3588  foreach tag $data($win,config,csl_tags) {
3589  catch { $win._t tag remove $tag $langstart $langend}
3590  }
3591 
3592  # Add new tags
3593  foreach tag [array names tags] {
3594  $win._t tag add $tag {*}$tags($tag)
3595  }
3596 
3597  # Calculate the return value
3598  set retval [expr (($retval == 2) || ([llength [array names tag_changed __Lang*:*]] > 0)) ? 2 : 1]
3599 
3600  }
3601 
3602  array unset tag_changed {*:$lang[01]}
3603 
3604  }
3605 
3606  return $retval
3607 
3608  }

§ comments_chars_deleted()

ctext::comments_chars_deleted   win start end pdo_tags  

Definition at line 3363 of file ctext.tcl.

3363  proc comments_chars_deleted {win start end pdo_tags} {
3364 
3365  variable data
3366 
3367  upvar $pdo_tags do_tags
3368 
3369  foreach tag $data($win,config,csl_markers) {
3370  lassign [$win tag nextrange $tag $start] tag_start tag_end
3371  if {($tag_start ne "") && [$win compare $tag_start < $end]} {
3372  lappend do_tags $tag 1
3373  return
3374  }
3375  }
3376 
3377  }

§ comments_do_tag()

ctext::comments_do_tag   win start end pdo_tags  

Definition at line 3379 of file ctext.tcl.

3379  proc comments_do_tag {win start end pdo_tags} {
3380 
3381  upvar $pdo_tags do_tags
3382 
3383  if {($do_tags eq "") && [inLineComment $win $start] && ([string first \n [$win get $start $end]] != -1)} {
3384  lappend do_tags "stuff" 1
3385  }
3386 
3387  }

§ create()

ctext::create   win args  

Definition at line 39 of file ctext.tcl.

39  proc create {win args} {
40 
41  variable data
42  variable right_click
43  variable REs
44 
45  if {[llength $args] & 1} {
46  return -code error "Invalid number of arguments given to ctext (uneven number after window) : $args"
47  }
48 
49  frame $win -class Ctext ;# -padx 1 -pady 1
50 
51  set tmp [text .__ctextTemp]
52 
53  set data($win,config,-fg) [$tmp cget -foreground]
54  set data($win,config,-bg) [$tmp cget -background]
55  set data($win,config,-font) [$tmp cget -font]
56  set data($win,config,-relief) [$tmp cget -relief]
57  set data($win,config,-unhighlightcolor) [$win cget -bg]
58  destroy $tmp
59  set data($win,config,-xscrollcommand) ""
60  set data($win,config,-yscrollcommand) ""
61  set data($win,config,-highlightcolor) "yellow"
62  set data($win,config,-linemap) 1
63  set data($win,config,-linemapfg) $data($win,config,-fg)
64  set data($win,config,-linemapbg) $data($win,config,-bg)
65  set data($win,config,-linemap_mark_command) {}
66  set data($win,config,-linemap_markable) 1
67  set data($win,config,-linemap_mark_color) orange
68  set data($win,config,-linemap_cursor) left_ptr
69  set data($win,config,-linemap_relief) $data($win,config,-relief)
70  set data($win,config,-linemap_minwidth) 1
71  set data($win,config,-linemap_type) absolute
72  set data($win,config,-linemap_align) left
73  set data($win,config,-linemap_separator) auto
74  set data($win,config,-linemap_separator_color) red
75  set data($win,config,-highlight) 1
76  set data($win,config,-lmargin) 0
77  set data($win,config,-warnwidth) ""
78  set data($win,config,-warnwidth_bg) red
79  set data($win,config,-casesensitive) 1
80  set data($win,config,-escapes) 1
81  set data($win,config,-peer) ""
82  set data($win,config,-undo) 0
83  set data($win,config,-maxundo) 0
84  set data($win,config,-autoseparators) 0
85  set data($win,config,-diff_mode) 0
86  set data($win,config,-diffsubbg) "pink"
87  set data($win,config,-diffaddbg) "light green"
88  set data($win,config,-folding) 0
89  set data($win,config,-delimiters) $REs(words)
90  set data($win,config,-matchchar) 0
91  set data($win,config,-matchchar_bg) $data($win,config,-fg)
92  set data($win,config,-matchchar_fg) $data($win,config,-bg)
93  set data($win,config,-matchaudit) 0
94  set data($win,config,-matchaudit_bg) "red"
95  set data($win,config,-theme) [list]
96  set data($win,config,-hidemeta) 0
97  set data($win,config,re_opts) ""
98  set data($win,config,win) $win
99  set data($win,config,modified) 0
100  set data($win,config,lastUpdate) 0
101  set data($win,config,csl_array) [list]
102  set data($win,config,csl_markers) [list]
103  set data($win,config,csl_tag_pair) [list]
104  set data($win,config,csl_tags) [list]
105  set data($win,config,langs) [list {}]
106  set data($win,config,gutters) [list]
107  set data($win,config,undo_hist) [list]
108  set data($win,config,undo_hist_size) 0
109  set data($win,config,undo_sep_last) -1
110  set data($win,config,undo_sep_next) -1
111  set data($win,config,undo_sep_size) 0
112  set data($win,config,undo_sep_count) 0
113  set data($win,config,redo_hist) [list]
114  set data($win,config,linemap_cmd_ip) 0
115  set data($win,config,meta_classes) [list]
116 
117  set data($win,config,ctextFlags) [list -xscrollcommand -yscrollcommand -linemap -linemapfg -linemapbg \
118  -font -linemap_mark_command -highlight -warnwidth -warnwidth_bg -linemap_markable \
119  -linemap_cursor -highlightcolor -folding -delimiters -matchchar -matchchar_bg -matchchar_fg -matchaudit -matchaudit_bg \
120  -linemap_mark_color -linemap_relief -linemap_minwidth -linemap_type -linemap_align \
121  -linemap_separator -linemap_separator_color -casesensitive -peer -theme -hidemeta \
122  -undo -maxundo -autoseparators -diff_mode -diffsubbg -diffaddbg -escapes -spacing3 -lmargin]
123 
124  # Set args
125  foreach {name value} $args {
126  set data($win,config,$name) $value
127  }
128 
129  set data($win,fontwidth) [font measure $data($win,config,-font) -displayof . "0"]
130  set data($win,fontdescent) [font metrics $data($win,config,-font) -displayof . -descent]
131 
132  foreach flag {foreground background} short {fg bg} {
133  if {[info exists data($win,config,-$flag)] == 1} {
134  set data($win,config,-$short) $data($win,config,-$flag)
135  unset data($win,config,-$flag)
136  }
137  }
138 
139  # Now remove flags that will confuse text and those that need
140  # modification:
141  foreach arg $data($win,config,ctextFlags) {
142  if {[set loc [lsearch $args $arg]] >= 0} {
143  set args [lreplace $args $loc [expr {$loc + 1}]]
144  }
145  }
146 
147  # Initialize the starting linemap ID
148  set data($win,linemap,id) 0
149 
150  canvas $win.l -relief $data($win,config,-relief) -bd 0 \
151  -bg $data($win,config,-linemapbg) -takefocus 0 -highlightthickness 0
152  frame $win.f -width 1 -bd 0 -relief flat -bg $data($win,config,-linemap_separator_color)
153 
154  set args [concat $args [list -yscrollcommand [list ctext::event:yscroll $win $data($win,config,-yscrollcommand)]] \
155  [list -xscrollcommand [list ctext::event:xscroll $win $data($win,config,-xscrollcommand)]]]
156 
157  if {$data($win,config,-peer) eq ""} {
158  text $win.t -font $data($win,config,-font) -bd 0 -highlightthickness 0 {*}$args
159  } else {
160  $data($win,config,-peer)._t peer create $win.t -font $data($win,config,-font) -bd 0 -highlightthickness 0 {*}$args
161  }
162 
163  frame $win.t.w -width 1 -bd 0 -relief flat -bg $data($win,config,-warnwidth_bg)
164 
165  if {$data($win,config,-warnwidth) ne ""} {
166  place $win.t.w -x [expr $data($win,config,-lmargin) + [font measure [$win.t cget -font] -displayof . [string repeat "m" $data($win,config,-warnwidth)]]] -relheight 1.0
167  }
168 
169  grid rowconfigure $win 0 -weight 100
170  grid columnconfigure $win 2 -weight 100
171  grid $win.l -row 0 -column 0 -sticky ns
172  grid $win.f -row 0 -column 1 -sticky ns
173  grid $win.t -row 0 -column 2 -sticky news
174 
175  # Hide the linemap and separator if we are specified to do so
176  if {!$data($win,config,-linemap) && !$data($win,config,-linemap_markable) && !$data($win,config,-folding)} {
177  grid remove $win.l
178  grid remove $win.f
179  }
180 
181  # Add the layer tags
182  $win.t tag configure _visibleH
183  $win.t tag configure _visibleL
184  $win.t tag configure _invisible
185  $win.t tag lower _visibleH sel
186  $win.t tag lower _visibleL _visibleH
187  $win.t tag lower _invisible _visibleL
188 
189  # Add default classes
190  $win.t tag configure __escape
191  $win.t tag configure __prewhite
192  $win.t tag configure rmargin
193  $win.t tag configure lmargin
194  $win.t tag lower __escape _invisible
195  $win.t tag lower __prewhite _invisible
196  $win.t tag lower rmargin _invisible
197  $win.t tag lower lmargin _invisible
198 
199  # If -matchchar is set, create the tag
200  if {$data($win,config,-matchchar)} {
201  $win.t tag configure matchchar -foreground $data($win,config,-matchchar_fg) -background $data($win,config,-matchchar_bg)
202  $win.t tag lower matchchar sel
203  }
204 
205 
206  bind $win.t <Configure> [list ctext::linemapUpdate $win]
207  bind $win.t <<CursorChanged>> [list ctext::linemapUpdate $win]
208  bind $win.l <Button-$right_click> [list ctext::linemapToggleMark $win %x %y]
209  bind $win.l <MouseWheel> [list event generate $win.t <MouseWheel> -delta %D]
210  bind $win.l <4> [list event generate $win.t <4>]
211  bind $win.l <5> [list event generate $win.t <5>]
212  bind $win.t <Destroy> [list ctext::event:Destroy $win]
213 
214  bindtags $win.t [linsert [bindtags $win.t] 0 $win]
215 
216  return $win
217 
218  }

§ deleteHighlightClass()

ctext::deleteHighlightClass   win class  

Definition at line 4105 of file ctext.tcl.

4105  proc deleteHighlightClass {win class} {
4106 
4107  variable data
4108 
4109  array unset data $win,highlight,regexp,class,*,__$class,*
4110  foreach key [array names data $win,highlight,regexps,*] {
4111  foreach index [lreverse [lsearch -all $data($key) *regexp,class,*,__$class,*]] {
4112  set data($key) [lreplace $data($key) $index $index]
4113  }
4114  }
4115 
4116  foreach type [list wkeyword wcharstart] {
4117  foreach key [array names data $win,highlight,$type,class,*] {
4118  if {[string match $data($key) __$class]} {
4119  unset data($key)
4120  }
4121  }
4122  }
4123 
4124  if {[set index [lsearch $data($win,config,meta_classes) $class]] != -1} {
4125  set data($win,config,meta_classes) [lreplace $data($win,config,meta_classes) $index $index]
4126  }
4127 
4128  array unset data $win,highlight,searches,__$class
4129  array unset data $win,classopts,$class
4130  array unset data $win,classimmediate,$class
4131 
4132  $win._t tag delete __$class 1.0 end
4133 
4134  }

§ deleteHighlightCommand()

ctext::deleteHighlightCommand   win command  

Definition at line 4138 of file ctext.tcl.

4138  proc deleteHighlightCommand {win command} {
4139 
4140  variable data
4141 
4142  array unset data $win,highlight,regexp,command,*,$command,*
4143  foreach key [array names data $win,highlight,regexps,*] {
4144  foreach index [lreverse [lsearch -all $data($key) regexp,command,*,$command,*]] {
4145  set data($key) [lreplace $data($key) $index $index]
4146  }
4147  }
4148 
4149  foreach type [list wkeyword wcharstart] {
4150  foreach key [array names data $win,highlight,$type,command,*] {
4151  if {[string match $data($key) $command]} {
4152  unset data($key)
4153  }
4154  }
4155  }
4156 
4157  }

§ doConfigure()

ctext::doConfigure   win  

Definition at line 4524 of file ctext.tcl.

4524  proc doConfigure {win} {
4525 
4526  # Update the linemap
4527  linemapUpdate $win
4528 
4529  # Update the rmargin
4530  adjust_rmargin $win
4531 
4532  }

§ escapes()

ctext::escapes   win start end  

Definition at line 3641 of file ctext.tcl.

3641  proc escapes {win start end} {
3642 
3643  variable data
3644 
3645  if {$data($win,config,-escapes)} {
3646  foreach res [$win._t search -all -- "\\" $start $end] {
3647  if {[lsearch [$win._t tag names $res-1c] __escape] == -1} {
3648  $win._t tag add __escape $res
3649  }
3650  }
3651  }
3652 
3653  }

§ event:Destroy()

ctext::event:Destroy   win  

Definition at line 264 of file ctext.tcl.

264  proc event:Destroy {win} {
265 
266  variable data
267 
268  bgproc::killall ctext::*
269 
270  catch { rename $win {}}
271  interp alias {} $win.t {}
272  array unset data $win,*
273 
274  }

§ event:xscroll()

ctext::event:xscroll   win clientData args  

Definition at line 220 of file ctext.tcl.

220  proc event:xscroll {win clientData args} {
221 
222  variable data
223 
224  if {$clientData == ""} {
225  return
226  }
227 
228  uplevel \#0 $clientData $args
229 
230  lassign $args first last
231 
232  if {$first > 0} {
233  set first_line [lindex [split [$win.t index @0,0] .] 0]
234  set last_line [lindex [split [$win.t index @0,[winfo height $win.t]] .] 0]
235  set longest 0
236  for {set i $first_line} {$i <= $last_line} {incr i} {
237  if {[set len [lindex [split [$win.t index $i.end] .] 1]] > $longest} {
238  set longest $len
239  }
240  }
241  set cwidth [font measure [$win._t cget -font] -displayof . "m"]
242  set missing [expr round( ($longest * $cwidth) * $first )]
243  } else {
244  set missing 0
245  }
246 
247  # Adjust the warning width line, if one was requested
248  set_warnwidth $win [expr 0 - $missing]
249 
250  }

§ event:yscroll()

ctext::event:yscroll   win clientData args  

Definition at line 252 of file ctext.tcl.

252  proc event:yscroll {win clientData args} {
253 
254  linemapUpdate $win
255 
256  if {$clientData == ""} {
257  return
258  }
259 
260  uplevel \#0 $clientData $args
261 
262  }

§ execute_gutter_cmd()

ctext::execute_gutter_cmd   win y cmd  

Definition at line 2710 of file ctext.tcl.

2710  proc execute_gutter_cmd {win y cmd} {
2711 
2712  # Get the line of the text widget
2713  set line [lindex [split [$win.t index @0,$y] .] 0]
2714 
2715  # Execute the command
2716  uplevel #0 [list {*}$cmd $win $line]
2717 
2718  }

§ getAutoMatchChars()

ctext::getAutoMatchChars   win lang  

Definition at line 2720 of file ctext.tcl.

2720  proc getAutoMatchChars {win lang} {
2721 
2722  variable data
2723 
2724  set chars [list]
2725 
2726  foreach name [array names data $win,config,matchChar,$lang,*] {
2727  lappend chars [lindex [split $name ,] 4]
2728  }
2729 
2730  return $chars
2731 
2732  }

§ getGutterTags()

ctext::getGutterTags   win pos  

Definition at line 1300 of file ctext.tcl.

1300  proc getGutterTags {win pos} {
1301 
1302  set alltags [$win tag names $pos]
1303  set tags [lsearch -inline -all -glob $alltags gutter:*]
1304  lappend tags {*}[lsearch -inline -all -glob $alltags lmark*]
1305 
1306  return $tags
1307 
1308  }

§ getHighlightClasses()

ctext::getHighlightClasses   win ?index?  

Definition at line 4162 of file ctext.tcl.

4162  proc getHighlightClasses {win {index ""}} {
4163 
4164  variable data
4165 
4166  if {$index eq ""} {
4167  set classes [list]
4168  foreach class [array names data $win,classopts,*] {
4169  lappend classes [lindex [split $class ,] 2]
4170  }
4171  } else {
4172  foreach tag [$win._t tag names $index] {
4173  set t [string range $tag 2 end]
4174  if {[info exists data($win,classopts,$t)]} {
4175  lappend classes $t
4176  }
4177  }
4178  }
4179 
4180  return $classes
4181 
4182  }

§ getLang()

ctext::getLang   win index  

Definition at line 3076 of file ctext.tcl.

3076  proc getLang {win index} {
3077 
3078  return [lindex [split [lindex [$win tag names $index] 0] =] 1]
3079 
3080  }

§ getMatchBracket()

ctext::getMatchBracket   win stype ?index?  

Definition at line 2835 of file ctext.tcl.

2835  proc getMatchBracket {win stype {index insert}} {
2836 
2837  set count 1
2838 
2839  if {[string index $stype end] eq "R"} {
2840 
2841  set otype [string range $stype 0 end-1]L
2842 
2843  lassign [$win tag nextrange __$stype "$index+1c"] sfirst slast
2844  lassign [$win tag prevrange __$otype $index] ofirst olast
2845  set ofirst "$index+1c"
2846 
2847  if {($olast eq "") || [$win compare $olast < $index]} {
2848  lassign [$win tag nextrange __$otype $index] dummy olast
2849  }
2850 
2851  while {($olast ne "") && ($slast ne "")} {
2852  if {[$win compare $slast < $olast]} {
2853  if {[incr count -[$win count -chars $sfirst $slast]] <= 0} {
2854  return "$slast-[expr 1 - $count]c"
2855  }
2856  lassign [$win tag nextrange __$stype "$slast+1c"] sfirst slast
2857  } else {
2858  incr count [$win count -chars $ofirst $olast]
2859  lassign [$win tag nextrange __$otype "$olast+1c"] ofirst olast
2860  }
2861  }
2862 
2863  while {$slast ne ""} {
2864  if {[incr count -[$win count -chars $sfirst $slast]] <= 0} {
2865  return "$slast-[expr 1 - $count]c"
2866  }
2867  lassign [$win tag nextrange __$stype "$slast+1c"] sfirst slast
2868  }
2869 
2870  } else {
2871 
2872  set otype [string range $stype 0 end-1]R
2873 
2874  lassign [$win tag prevrange __$stype $index] sfirst slast
2875  lassign [$win tag prevrange __$otype $index] ofirst olast
2876 
2877  if {($olast ne "") && [$win compare $olast >= $index]} {
2878  set olast $index
2879  }
2880 
2881  while {($ofirst ne "") && ($sfirst ne "")} {
2882  if {[$win compare $sfirst > $ofirst]} {
2883  if {[incr count -[$win count -chars $sfirst $slast]] <= 0} {
2884  return "$sfirst+[expr 0 - $count]c"
2885  }
2886  lassign [$win tag prevrange __$stype $sfirst] sfirst slast
2887  } else {
2888  incr count [$win count -chars $ofirst $olast]
2889  lassign [$win tag prevrange __$otype $ofirst] ofirst olast
2890  }
2891  }
2892 
2893  while {$sfirst ne ""} {
2894  if {[incr count -[$win count -chars $sfirst $slast]] <= 0} {
2895  return "$sfirst+[expr 0 - $count]c"
2896  }
2897  lassign [$win tag prevrange __$stype $sfirst] sfirst slast
2898  }
2899 
2900  }
2901 
2902  return ""
2903 
2904  }

§ getNextBracket()

ctext::getNextBracket   win stype ?index?  

Definition at line 2817 of file ctext.tcl.

2817  proc getNextBracket {win stype {index insert}} {
2818 
2819  lassign [$win tag prevrange __$stype "$index+1c"] first last
2820 
2821  if {($last ne "") && [$win compare "$index+1c" < $last]} {
2822  return [$win index "$index+1c"]
2823  } else {
2824  lassign [$win tag nextrange __$stype "$index+1c"] first last
2825  return $first
2826  }
2827 
2828  }

§ getPrevBracket()

ctext::getPrevBracket   win stype ?index?  

Definition at line 2801 of file ctext.tcl.

2801  proc getPrevBracket {win stype {index insert}} {
2802 
2803  lassign [$win tag prevrange __$stype $index] first last
2804 
2805  if {$last eq ""} {
2806  return ""
2807  } elseif {[$win compare $last < $index]} {
2808  return [$win index "$last-1c"]
2809  } else {
2810  return [$win index "$index-1c"]
2811  }
2812 
2813  }

§ getTagInRange()

ctext::getTagInRange   win tag start end  

Definition at line 3345 of file ctext.tcl.

3345  proc getTagInRange {win tag start end} {
3346 
3347  set indices [list]
3348 
3349  while {1} {
3350  lassign [$win tag nextrange $tag $start] tag_start tag_end
3351  if {($tag_start ne "") && [$win compare $tag_start < $end]} {
3352  lappend indices $tag_start $tag_end
3353  } else {
3354  break
3355  }
3356  set start $tag_end
3357  }
3358 
3359  return $indices
3360 
3361  }

§ gotoBracketMismatch()

ctext::gotoBracketMismatch   win dir args  

Definition at line 3030 of file ctext.tcl.

3030  proc gotoBracketMismatch {win dir args} {
3031 
3032  variable data
3033 
3034  # If the current text buffer was not highlighted, do it now
3035  if {!$data($win,config,-matchaudit)} {
3036  return 0
3037  }
3038 
3039  array set opts {
3040  -check 0
3041  }
3042  array set opts $args
3043 
3044  # Find the previous/next index
3045  if {$dir eq "next"} {
3046  set index end
3047  foreach type [list square curly paren angled] {
3048  lassign [$win._t tag nextrange missing:$type "insert+1c"] first
3049  if {($first ne "") && [$win._t compare $first < $index]} {
3050  set index $first
3051  }
3052  }
3053  } else {
3054  set index 1.0
3055  foreach type [list square curly paren angled] {
3056  lassign [$win._t tag prevrange missing:$type insert] first
3057  if {($first ne "") && [$win._t compare $first > $index]} {
3058  set index $first
3059  }
3060  }
3061  }
3062 
3063  # Make sure that the current bracket is in view
3064  if {[lsearch [$win._t tag names $index] missing:*] != -1} {
3065  if {!$opts(-check)} {
3066  ::tk::TextSetCursor $win.t $index
3067  $win._t see $index
3068  }
3069  return 1
3070  }
3071 
3072  return 0
3073 
3074  }

§ handleClickCommand()

ctext::handleClickCommand   win tag command  

Definition at line 4066 of file ctext.tcl.

4066  proc handleClickCommand {win tag command} {
4067 
4068  # Get the clicked text range
4069  lassign [$win._t tag prevrange $tag [$win._t index current+1c]] startpos endpos
4070 
4071  # Call the command
4072  uplevel #0 [list {*}$command $win $startpos $endpos]
4073 
4074  }

§ handleDeleteAt0()

ctext::handleDeleteAt0   win startpos endpos  

Definition at line 1336 of file ctext.tcl.

1336  proc handleDeleteAt0 {win startpos endpos} {
1337 
1338  lassign [split $startpos .] startrow startcol
1339  lassign [split $endpos .] endrow endcol
1340 
1341  if {$startrow == $endrow} {
1342  if {$startcol == 0} {
1343  handleDeleteAt0Helper $win $startrow.0 $endpos
1344  }
1345  } elseif {$endcol != 0} {
1346  handleDeleteAt0Helper $win $endrow.0 $endpos
1347  }
1348 
1349  }

§ handleDeleteAt0Helper()

ctext::handleDeleteAt0Helper   win firstpos endpos  

Definition at line 1325 of file ctext.tcl.

1325  proc handleDeleteAt0Helper {win firstpos endpos} {
1326 
1327  foreach tag [getGutterTags $win $firstpos] {
1328  $win._t tag add $tag $endpos
1329  }
1330 
1331  }

§ handleFocusIn()

ctext::handleFocusIn   win  

Definition at line 889 of file ctext.tcl.

889  proc handleFocusIn {win} {
890 
891  variable data
892 
893  __ctextJunk$win configure -bg $data($win,config,-highlightcolor)
894 
895  }

§ handleFocusOut()

ctext::handleFocusOut   win  

Definition at line 897 of file ctext.tcl.

897  proc handleFocusOut {win} {
898 
899  variable data
900 
901  __ctextJunk$win configure -bg $data($win,config,-unhighlightcolor)
902 
903  }

§ handleInsertAt0()

ctext::handleInsertAt0   win startpos datalen  

Definition at line 1313 of file ctext.tcl.

1313  proc handleInsertAt0 {win startpos datalen} {
1314 
1315  if {[lindex [split $startpos .] 1] == 0} {
1316  set endpos [$win index "$startpos+${datalen}c"]
1317  foreach tag [getGutterTags $win $endpos] {
1318  $win tag add $tag $startpos
1319  $win tag remove $tag $endpos
1320  }
1321  }
1322 
1323  }

§ handleReplaceDeleteAt0()

ctext::handleReplaceDeleteAt0   win startpos endpos  

Definition at line 1353 of file ctext.tcl.

1353  proc handleReplaceDeleteAt0 {win startpos endpos} {
1354 
1355  lassign [split $startpos .] startrow startcol
1356  lassign [split $endpos .] endrow endcol
1357 
1358  if {$startrow == $endrow} {
1359  if {$startcol == 0} {
1360  return [list 0 [getGutterTags $win $startrow.0]]
1361  }
1362  } elseif {$endcol != 0} {
1363  return [list 1 [getGutterTags $win $endrow.0]]
1364  }
1365 
1366  return [list 0 [list]]
1367 
1368  }

§ handleReplaceInsert()

ctext::handleReplaceInsert   win startpos datalen tags  

Definition at line 1370 of file ctext.tcl.

1370  proc handleReplaceInsert {win startpos datalen tags} {
1371 
1372  if {[lindex $tags 0]} {
1373  set insertpos [$win._t index "$startpos+${datalen}c"]
1374  } else {
1375  set insertpos $startpos
1376  }
1377 
1378  foreach tag $tags {
1379  $win._t tag add $tag $insertpos
1380  }
1381 
1382  }

§ highlight()

ctext::highlight   win start end ins  

Definition at line 4184 of file ctext.tcl.

4184  proc highlight {win start end ins} {
4185 
4186  variable data
4187  variable REs
4188  variable restart_from
4189 
4190  set twin "$win._t"
4191  set tags [dict create]
4192 
4193  foreach lang $data($win,config,langs) {
4194 
4195  # Get the ranges to check
4196  if {$lang eq ""} {
4197  set ranges [list 1.0 end]
4198  } else {
4199  set ranges [$twin tag ranges "__Lang=$lang"]
4200  }
4201 
4202  # Perform highlighting for each range
4203  foreach {langstart langend} $ranges {
4204 
4205  if {[$twin compare $start > $langend] || [$twin compare $langstart > $end]} continue
4206  if {[$twin compare $start <= $langstart]} { set pstart $langstart} else { set pstart $start}
4207  if {[$twin compare $langend <= $end]} { set pend $langend} else { set pend $end}
4208 
4209  brackets $win $pstart $pend $lang tags
4210  indentation $win $pstart $pend $lang tags
4211  words $win $pstart $pend $lang $ins tags
4212  regexps $win $pstart $pend $lang $ins tags
4213  searches $win $pstart $pend tags
4214 
4215  }
4216 
4217  }
4218 
4219  # Update the tags
4220  dict for {tag indices} $tags {
4221  $win._t tag add $tag {*}$indices
4222  }
4223 
4224  }

§ highlightAll()

ctext::highlightAll   win lineranges ins ?do_tag?  

Definition at line 3279 of file ctext.tcl.

3279  proc highlightAll {win lineranges ins {do_tag ""}} {
3280 
3281  variable data
3282  variable range_cache
3283 
3284  array set csl_array $data($win,config,csl_array)
3285 
3286  # Delete all of the tags not associated with comments and strings that we created
3287  foreach tag [$win._t tag names] {
3288  if {([string range $tag 0 1] eq "__") && ![info exists csl_array($tag)]} {
3289  $win._t tag remove $tag {*}$lineranges
3290  }
3291  }
3292 
3293  # Clear the caches
3294  array unset range_cache $win,*
3295 
3296  # Group the ranges to remove as much regular expression text searching as possible
3297  set ranges [list]
3298  set laststart [lindex $lineranges 0]
3299  set lastend [lindex $lineranges 1]
3300  foreach {linestart lineend} [lrange $lineranges 2 end] {
3301  if {[$win count -lines $lastend $linestart] > 10} {
3302  lappend ranges $laststart $lastend
3303  set laststart $linestart
3304  }
3305  set lastend $lineend
3306  }
3307  lappend ranges $laststart $lastend
3308 
3309  # Tag escapes and prewhite characters
3310  foreach {linestart lineend} $ranges {
3311  escapes $win $linestart $lineend
3312  prewhite $win $linestart $lineend
3313  }
3314 
3315  # If highlighting is not specified, stop here
3316  if {!$data($win,config,-highlight)} { return 0}
3317 
3318  # Tag comments and strings
3319  set all [comments $win $ranges $do_tag]
3320 
3321  # Update the language backgrounds for embedded languages
3323 
3324  if {$all == 2} {
3325  foreach tag [$win._t tag names] {
3326  if {([string index $tag 0] eq "__") && ($tag ne "__escape") && ![info exists csl_array($tag)]} {
3327  $win._t tag remove $tag [lindex $lineranges 1] end
3328  }
3329  }
3330  highlight $win [lindex $lineranges 0] end $ins
3331  } else {
3332  foreach {linestart lineend} $ranges {
3333  highlight $win $linestart $lineend $ins
3334  }
3335  }
3336 
3337  if {$all} {
3338  event generate $win.t <<StringCommentChanged>>
3339  }
3340 
3341  return $all
3342 
3343  }

§ highlightSearch()

ctext::highlightSearch   win class str ?opts?  

Definition at line 3976 of file ctext.tcl.

3976  proc highlightSearch {win class str {opts ""}} {
3977 
3978  variable data
3979 
3980  # Add the highlight class
3981  addHighlightClass $win $class -fgtheme search -bgtheme search -priority high
3982 
3983  # Save the information
3984  set data($win,highlight,searches,__$class) [list $str $opts]
3985 
3986  # Perform the search now
3987  set i 0
3988  foreach res [$win._t search -count lengths {*}$opts -all -- $str 1.0 end] {
3989  lappend matches $res [$win._t index "$res + [lindex $lengths $i] chars"]
3990  incr i
3991  }
3992 
3993  catch { $win._t tag add __$class {*}$matches}
3994 
3995  }

§ inBackTick()

ctext::inBackTick   win index  

Definition at line 714 of file ctext.tcl.

714  proc inBackTick {win index} {
715 
716  return [inCommentStringHelper $win $index __comstr0b]
717 
718  }

§ inBackTickRange()

ctext::inBackTickRange   win index prange  

Definition at line 812 of file ctext.tcl.

812  proc inBackTickRange {win index prange} {
813 
814  return [inCommentStringRangeHelper $win $index __comstr0b* $prange]
815 
816  }

§ inBlockComment()

ctext::inBlockComment   win index  

Definition at line 702 of file ctext.tcl.

702  proc inBlockComment {win index} {
703 
704  return [inCommentStringHelper $win $index __comstr1c]
705 
706  }

§ inBlockCommentRange()

ctext::inBlockCommentRange   win index prange  

Definition at line 780 of file ctext.tcl.

780  proc inBlockCommentRange {win index prange} {
781 
782  return [inCommentStringRangeHelper $win $index __comstr1c* $prange]
783 
784  }

§ inBlockRange()

ctext::inBlockRange   win type index prange  

Definition at line 862 of file ctext.tcl.

862  proc inBlockRange {win type index prange} {
863 
864  upvar $prange range
865 
866  set range [list "" ""]
867 
868  # Search backwards
869  if {[lsearch [$win._t tag names $index] __${type}L] == -1} {
870  set startpos $index
871  } else {
872  set startpos "$index+1c"
873  }
874 
875  if {[set left [getMatchBracket $win ${type}L $startpos]] ne ""} {
876  set right [getMatchBracket $win ${type}R $left]
877  if {($right eq "") || [$win._t compare $right < $index]} {
878  return 0
879  } else {
880  set range [list [$win._t index $left] [$win._t index $right]]
881  return 1
882  }
883  }
884 
885  return 0
886 
887  }

§ inComment()

ctext::inComment   win index  

Definition at line 708 of file ctext.tcl.

708  proc inComment {win index} {
709 
710  return [inCommentStringHelper $win $index __comstr1]
711 
712  }

§ inCommentRange()

ctext::inCommentRange   win index prange  

Definition at line 786 of file ctext.tcl.

786  proc inCommentRange {win index prange} {
787 
788  return [inCommentStringRangeHelper $win $index __comstr1* $prange]
789 
790  }

§ inCommentString()

ctext::inCommentString   win index  

Definition at line 756 of file ctext.tcl.

756  proc inCommentString {win index} {
757 
758  return [inCommentStringHelper $win $index __comstr]
759 
760  }

§ inCommentStringHelper()

ctext::inCommentStringHelper   win index pattern  

Definition at line 688 of file ctext.tcl.

688  proc inCommentStringHelper {win index pattern} {
689 
690  set names [$win tag names $index]
691 
692  return [expr {[string map [list $pattern {}] $names] ne $names}]
693 
694  }

§ inCommentStringRange()

ctext::inCommentStringRange   win index prange  

Definition at line 854 of file ctext.tcl.

854  proc inCommentStringRange {win index prange} {
855 
856  return [inCommentStringRangeHelper $win $index __comstr* $prange]
857 
858  }

§ inCommentStringRangeHelper()

ctext::inCommentStringRangeHelper   win index pattern prange  

Definition at line 762 of file ctext.tcl.

762  proc inCommentStringRangeHelper {win index pattern prange} {
763 
764  if {[set curr_tag [lsearch -inline -glob [$win tag names $index] $pattern]] ne ""} {
765  upvar 2 $prange range
766  set range [$win tag prevrange $curr_tag $index+1c]
767  return 1
768  }
769 
770  return 0
771 
772  }

§ indentation()

ctext::indentation   win start end lang ptags  

Definition at line 3701 of file ctext.tcl.

3701  proc indentation {win start end lang ptags} {
3702 
3703  upvar $ptags tags
3704 
3705  variable data
3706 
3707  set lines [split [$win._t get $start $end] \n]
3708  set startrow [lindex [split $start .] 0]
3709 
3710  # Add indentation
3711  foreach key [array names data $win,config,indentation,$lang,*] {
3712  set type [lindex [split $key ,] 4]
3713  set i 0
3714  set row $startrow
3715  foreach line $lines {
3716  set col 0
3717  while {[regexp -indices -start $col -- $data($key) $line res]} {
3718  lassign $res scol ecol
3719  set col [expr $ecol + 1]
3720  dict lappend tags __$type[expr $i & 1] $row.$scol $row.$col
3721  incr i
3722  }
3723  incr row
3724  }
3725  }
3726 
3727  }

§ inDoubleQuote()

ctext::inDoubleQuote   win index  

Definition at line 726 of file ctext.tcl.

726  proc inDoubleQuote {win index} {
727 
728  return [inCommentStringHelper $win $index __comstr0d]
729 
730  }

§ inDoubleQuoteRange()

ctext::inDoubleQuoteRange   win index prange  

Definition at line 824 of file ctext.tcl.

824  proc inDoubleQuoteRange {win index prange} {
825 
826  return [inCommentStringRangeHelper $win $index __comstr0d* $prange]
827 
828  }

§ inLineComment()

ctext::inLineComment   win index  

Definition at line 696 of file ctext.tcl.

696  proc inLineComment {win index} {
697 
698  return [inCommentStringHelper $win $index __comstr1l]
699 
700  }

§ inLineCommentRange()

ctext::inLineCommentRange   win index prange  

Definition at line 774 of file ctext.tcl.

774  proc inLineCommentRange {win index prange} {
775 
776  return [inCommentStringRangeHelper $win $index __comstr1l $prange]
777 
778  }

§ inSingleQuote()

ctext::inSingleQuote   win index  

Definition at line 720 of file ctext.tcl.

720  proc inSingleQuote {win index} {
721 
722  return [inCommentStringHelper $win $index __comstr0s]
723 
724  }

§ inSingleQuoteRange()

ctext::inSingleQuoteRange   win index prange  

Definition at line 818 of file ctext.tcl.

818  proc inSingleQuoteRange {win index prange} {
819 
820  return [inCommentStringRangeHelper $win $index __comstr0s* $prange]
821 
822  }

§ instanceCmd()

ctext::instanceCmd   win cmd args  

Definition at line 1384 of file ctext.tcl.

1384  proc instanceCmd {win cmd args} {
1385 
1386  variable data
1387 
1388  switch -glob -- $cmd {
1389  append { return [command_append $win {*}$args]}
1390  cget { return [command_cget $win {*}$args]}
1391  conf* { return [command_configure $win {*}$args]}
1392  copy { return [command_copy $win {*}$args]}
1393  cut { return [command_cut $win {*}$args]}
1394  delete { return [command_delete $win {*}$args]}
1395  diff { return [command_diff $win {*}$args]}
1396  edit { return [command_edit $win {*}$args]}
1397  fastdelete { return [command_fastdelete $win {*}$args]}
1398  fastinsert { return [command_fastinsert $win {*}$args]}
1399  fastreplace { return [command_fastreplace $win {*}$args]}
1400  gutter { return [command_gutter $win {*}$args]}
1401  highlight { return [command_highlight $win {*}$args]}
1402  insert { return [command_insert $win {*}$args]}
1403  is { return [command_is $win {*}$args]}
1404  replace { return [command_replace $win {*}$args]}
1405  paste { return [command_paste $win {*}$args]}
1406  peer { return [command_peer $win {*}$args]}
1407  syntax { return [command_syntax $win {*}$args]}
1408  tag { return [command_tag $win {*}$args]}
1409  language { return [command_language $win {*}$args]}
1410  default { return [uplevel 1 [linsert $args 0 $win._t $cmd]]}
1411  }
1412 
1413  }

§ inString()

ctext::inString   win index  

Definition at line 750 of file ctext.tcl.

750  proc inString {win index} {
751 
752  return [inCommentStringHelper $win $index __comstr0]
753 
754  }

§ inStringRange()

ctext::inStringRange   win index prange  

Definition at line 848 of file ctext.tcl.

848  proc inStringRange {win index prange} {
849 
850  return [inCommentStringRangeHelper $win $index __comstr0* $prange]
851 
852  }

§ inTripleBackTick()

ctext::inTripleBackTick   win index  

Definition at line 732 of file ctext.tcl.

732  proc inTripleBackTick {win index} {
733 
734  return [inCommentStringHelper $win $index __comstr0B]
735 
736  }

§ inTripleBackTickRange()

ctext::inTripleBackTickRange   win index prange  

Definition at line 830 of file ctext.tcl.

830  proc inTripleBackTickRange {win index prange} {
831 
832  return [inCommentStringRangeHelper $win $index __comstr0B* $prange]
833 
834  }

§ inTripleDoubleQuote()

ctext::inTripleDoubleQuote   win index  

Definition at line 744 of file ctext.tcl.

744  proc inTripleDoubleQuote {win index} {
745 
746  return [inCommentStringHelper $win $index __comstr0D]
747 
748  }

§ inTripleDoubleQuoteRange()

ctext::inTripleDoubleQuoteRange   win index prange  

Definition at line 842 of file ctext.tcl.

842  proc inTripleDoubleQuoteRange {win index prange} {
843 
844  return [inCommentStringRangeHelper $win $index __comstr0D* $prange]
845 
846  }

§ inTripleSingleQuote()

ctext::inTripleSingleQuote   win index  

Definition at line 738 of file ctext.tcl.

738  proc inTripleSingleQuote {win index} {
739 
740  return [inCommentStringHelper $win $index __comstr0S]
741 
742  }

§ inTripleSingleQuoteRange()

ctext::inTripleSingleQuoteRange   win index prange  

Definition at line 836 of file ctext.tcl.

836  proc inTripleSingleQuoteRange {win index prange} {
837 
838  return [inCommentStringRangeHelper $win $index __comstr0S* $prange]
839 
840  }

§ isEscaped()

ctext::isEscaped   win index  

Definition at line 912 of file ctext.tcl.

912  proc isEscaped {win index} {
913 
914  set names [$win tag names $index-1c]
915 
916  return [expr {[string map {__escape {}} $names] ne $names}]
917 
918  }

§ isQuote()

ctext::isQuote   win char index side  

Definition at line 2026 of file ctext.tcl.

2026  proc isQuote {win char index side} {
2027 
2028  if {$side eq ""} {
2029  set side "any"
2030  } elseif {[lsearch [list left right any] $side] == -1} {
2031  return -code error "ctext 'is' command $type called with an illegal side value"
2032  }
2033 
2034  if {[lsearch [$win._t tag names $index] __${char}Quote*] != -1} {
2035  if {$side eq "any"} {
2036  return 1
2037  } else {
2038  set tag [lsearch -inline [$win._t tag names $index] __comstr0${char}*]
2039  set range [$win._t tag prevrange $tag "$index+1c"]
2040  return [expr {($side eq "left") ? [$win._t compare [lindex $range 0] == $index] : [$win._t compare [lindex $range 1] == "$index+1c"]}]
2041  }
2042  }
2043 
2044  return 0
2045 
2046  }

§ linemapCheckOnDelete()

ctext::linemapCheckOnDelete   win startpos ?endpos?  

Definition at line 4228 of file ctext.tcl.

4228  proc linemapCheckOnDelete {win startpos {endpos ""}} {
4229 
4230  variable data
4231 
4232  if {$data($win,config,-linemap_mark_command) ne ""} {
4233 
4234  if {$endpos eq ""} {
4235  set endpos $startpos
4236  }
4237 
4238  if {[lindex [split $startpos .] 1] == 0} {
4239  if {[set lmark [lsearch -inline -glob [$win._t tag names $startpos] lmark*]] ne ""} {
4240  uplevel #0 [list {*}$data($win,config,-linemap_mark_command) $win unmarked $lmark]
4241  }
4242  }
4243 
4244  while {[$win._t compare [set startpos [$win._t index "$startpos+1l linestart"]] < $endpos]} {
4245  if {[set lmark [lsearch -inline -glob [$win._t tag names $startpos] lmark*]] ne ""} {
4246  uplevel #0 [list {*}$data($win,config,-linemap_mark_command) $win unmarked $lmark]
4247  }
4248  }
4249 
4250  }
4251 
4252  }

§ linemapClearMark()

ctext::linemapClearMark   win line  

Definition at line 4314 of file ctext.tcl.

4314  proc linemapClearMark {win line} {
4315 
4316  if {[set lmark [lsearch -inline -glob [$win.t tag names $line.0] lmark*]] ne ""} {
4317  $win.t tag delete $lmark
4318  linemapUpdate $win 1
4319  }
4320 
4321  }

§ linemapDiffUpdate()

ctext::linemapDiffUpdate   win first last linenum_width  

Definition at line 4414 of file ctext.tcl.

4414  proc linemapDiffUpdate {win first last linenum_width} {
4415 
4416  variable data
4417 
4418  set normal $data($win,config,-linemapfg)
4419  set lmark $data($win,config,-linemap_mark_color)
4420  set font $data($win,config,-font)
4421  set linebx [expr (($linenum_width + 1) * $data($win,fontwidth)) + 1]
4422  set gutterx [expr $linebx + ((($linenum_width + 1) * $data($win,fontwidth)) + 1)]
4423  set descent $data($win,fontdescent)
4424  set fmt [expr {($data($win,config,-linemap_align) eq "left") ? "%-*s %-*s" : "%*s %*s"}]
4425 
4426  # Calculate the starting line numbers for both files
4427  array set currline {A 0 B 0}
4428  foreach diff_tag [lsearch -inline -all -glob [$win.t tag names $first.0] diff:*] {
4429  lassign [split $diff_tag :] dummy index type start
4430  set currline($index) [expr $start - 1]
4431  if {$type eq "S"} {
4432  incr currline($index) [$win count -lines [lindex [$win tag ranges $diff_tag] 0] $first.0]
4433  }
4434  }
4435 
4436  for {set line $first} {$line <= $last} {incr line} {
4437  if {[$win._t count -displaychars $line.0 [expr $line + 1].0] == 0} { continue}
4438  lassign [$win._t dlineinfo $line.0] x y w h b
4439  set ltags [$win._t tag names $line.0]
4440  set y [expr $y + $b + $descent]
4441  set lineA [expr {([lsearch -glob $ltags diff:A:S:*] != -1) ? [incr currline(A)] : ""}]
4442  set lineB [expr {([lsearch -glob $ltags diff:B:S:*] != -1) ? [incr currline(B)] : ""}]
4443  set marked [expr {[lsearch -glob $ltags lmark*] != -1}]
4444  set fill [expr {$marked ? $lmark : $normal}]
4445  $win.l create text 1 $y -anchor sw -text [format $fmt $linenum_width $lineA $linenum_width $lineB] -fill $fill -font $font
4446  linemapUpdateGutter $win ltags $gutterx $y
4447  }
4448 
4449  }

§ linemapGutterUpdate()

ctext::linemapGutterUpdate   win first last linenum_width  

Definition at line 4482 of file ctext.tcl.

4482  proc linemapGutterUpdate {win first last linenum_width} {
4483 
4484  variable data
4485 
4486  set gutterx [expr {$data($win,config,-linemap_markable) ? (($data($win,fontwidth) * 2) + 1) : 1}]
4487  set fill $data($win,config,-linemap_mark_color)
4488  set font $data($win,config,-font)
4489  set descent $data($win,fontdescent)
4490 
4491  for {set line $first} {$line <= $last} {incr line} {
4492  if {[$win._t count -displaychars $line.0 [expr $line + 1].0] == 0} { continue}
4493  lassign [$win._t dlineinfo $line.0] x y w h b
4494  set ltags [$win.t tag names $line.0]
4495  set y [expr $y + $b + $descent]
4496  if {[lsearch -glob $ltags lmark*] != -1} {
4497  $win.l create text 1 $y -anchor sw -text "M" -fill $fill -font $font
4498  }
4499  linemapUpdateGutter $win ltags $gutterx $y
4500  }
4501 
4502  }

§ linemapLineUpdate()

ctext::linemapLineUpdate   win first last linenum_width  

Definition at line 4451 of file ctext.tcl.

4451  proc linemapLineUpdate {win first last linenum_width} {
4452 
4453  variable data
4454 
4455  set abs [expr {$data($win,config,-linemap_type) eq "absolute"}]
4456  set curr [lindex [split [$win.t index insert] .] 0]
4457  set lmark $data($win,config,-linemap_mark_color)
4458  set normal $data($win,config,-linemapfg)
4459  set font $data($win,config,-font)
4460  set gutterx [expr (($linenum_width + 1) * $data($win,fontwidth)) + 1]
4461  set descent $data($win,fontdescent)
4462  set fmt [expr {($data($win,config,-linemap_align) eq "left") ? "%-*s" : "%*s"}]
4463 
4464  if {$abs} {
4465  set curr 0
4466  }
4467 
4468  for {set line $first} {$line <= $last} {incr line} {
4469  if {[$win._t count -displaychars $line.0 [expr $line + 1].0] == 0} { continue}
4470  lassign [$win._t dlineinfo $line.0] x y w h b
4471  set ltags [$win.t tag names $line.0]
4472  set linenum [expr abs( $line - $curr )]
4473  set marked [expr {[lsearch -glob $ltags lmark*] != -1}]
4474  set fill [expr {$marked ? $lmark : $normal}]
4475  set y [expr $y + $b + $descent]
4476  $win.l create text 1 $y -anchor sw -text [format $fmt $linenum_width $linenum] -fill $fill -font $font
4477  linemapUpdateGutter $win ltags $gutterx $y
4478  }
4479 
4480  }

§ linemapMarkUpdate()

ctext::linemapMarkUpdate   win first last  

Definition at line 4504 of file ctext.tcl.

4504  proc linemapMarkUpdate {win first last} {
4505 
4506  variable data
4507 
4508  set fill $data($win,config,-linemap_mark_color)
4509  set font $data($win,config,-font)
4510  set descent $data($win,fontdescent)
4511 
4512  for {set line $first} {$line <= $last} {incr line} {
4513  if {[$win._t count -displaychars $line.0 [expr $line + 1].0] == 0} { continue}
4514  lassign [$win._t dlineinfo $line.0] x y w h b
4515  set ltags [$win.t tag names $line.0]
4516  set y [expr $y + $b + $descent]
4517  if {[lsearch -glob $ltags lmark*] != -1} {
4518  $win.l create text 1 $y -anchor sw -text "M" -fill $fill -font $font
4519  }
4520  }
4521 
4522  }

§ linemapSetMark()

ctext::linemapSetMark   win line  

Definition at line 4299 of file ctext.tcl.

4299  proc linemapSetMark {win line} {
4300 
4301  variable data
4302 
4303  if {[$win._t compare "$line.0 linestart" != "$line.0 lineend"] && [lsearch -inline -glob [$win.t tag names $line.0] lmark*] eq ""} {
4304  set lmark "lmark[incr data($win,linemap,id)]"
4305  $win.t tag add $lmark $line.0
4306  linemapUpdate $win 1
4307  return $lmark
4308  }
4309 
4310  return ""
4311 
4312  }

§ linemapToggleMark()

ctext::linemapToggleMark   win x y  

Definition at line 4254 of file ctext.tcl.

4254  proc linemapToggleMark {win x y} {
4255 
4256  variable data
4257 
4258  # If the linemap is not markable or the linemap command is in progress, ignore
4259  # further attempts to toggle the mark.
4260  if {!$data($win,config,-linemap_markable) || $data($win,config,linemap_cmd_ip)} {
4261  return
4262  }
4263 
4264  set tline [lindex [split [set tmarkChar [$win.t index @0,$y]] .] 0]
4265 
4266  # If the line is empty, we can't mark the line so just return now
4267  if {[$win._t compare "$tline.0 linestart" == "$tline.0 lineend"]} {
4268  return
4269  }
4270 
4271  if {[set lmark [lsearch -inline -glob [$win.t tag names $tline.0] lmark*]] ne ""} {
4272  $win.t tag delete $lmark
4273  set type unmarked
4274  } else {
4275  set lmark "lmark[incr data($win,linemap,id)]"
4276  $win.t tag add $lmark $tmarkChar [$win.t index "$tmarkChar lineend"]
4277  set type marked
4278  }
4279 
4280  # Update the linemap
4281  linemapUpdate $win 1
4282 
4283  # Indicate that the linemap command is in progress
4284  set data($win,config,linemap_cmd_ip) 1
4285 
4286  # Call the mark command, if one exists. If it returns a value of 0, remove
4287  # the mark.
4288  set cmd $data($win,config,-linemap_mark_command)
4289  if {[string length $cmd] && ![uplevel #0 [linsert $cmd end $win $type $lmark]]} {
4290  $win.t tag delete $lmark
4291  linemapUpdate $win 1
4292  }
4293 
4294  # Indicate that the linemap command is no longer in progress
4295  set data($win,config,linemap_cmd_ip) 0
4296 
4297  }

§ linemapUpdate()

ctext::linemapUpdate   win ?forceUpdate?  

Definition at line 4342 of file ctext.tcl.

4342  proc linemapUpdate {win {forceUpdate 0}} {
4343 
4344  variable data
4345 
4346  # Check to see if the current cursor is on a bracket and match it
4347  if {$data($win,config,-matchchar)} {
4348  matchBracket $win
4349  }
4350 
4351  # If there is no need to update, return now
4352  if {![winfo exists $win.l] || (![linemapUpdateNeeded $win] && !$forceUpdate)} {
4353  return
4354  }
4355 
4356  set first [lindex [split [$win.t index @0,0] .] 0]
4357  set last [lindex [split [$win.t index @0,[winfo height $win.t]] .] 0]
4358  set line_width [string length [lindex [split [$win._t index end-1c] .] 0]]
4359  set linenum_width [expr max( $data($win,config,-linemap_minwidth), $line_width )]
4360  set gutter_width [expr [llength [lsearch -index 2 -all -inline $data($win,config,gutters) 0]] + 1]
4361 
4362  if {[$win._t compare "@0,0 linestart" != @0,0]} {
4363  incr first
4364  }
4365 
4366  $win.l delete all
4367 
4368  if {$data($win,config,-diff_mode)} {
4369  linemapDiffUpdate $win $first $last $linenum_width
4370  set full_width [expr ($linenum_width * 2) + 1 + $gutter_width]
4371  } elseif {$data($win,config,-linemap)} {
4372  linemapLineUpdate $win $first $last $linenum_width
4373  set full_width [expr $linenum_width + $gutter_width]
4374  } elseif {$gutter_width > 0} {
4375  linemapGutterUpdate $win $first $last $linenum_width
4376  set full_width [expr $data($win,config,-linemap_markable) + $gutter_width]
4377  } elseif {$data($win,config,-linemap_markable)} {
4378  linemapMarkUpdate $win $first $last
4379  set full_width 1
4380  }
4381 
4382  # Resize the linemap window, if necessary
4383  if {[$win.l cget -width] != (($full_width * $data($win,fontwidth)) + 2)} {
4384  $win.l configure -width [expr ($full_width * $data($win,fontwidth)) + 2]
4385  }
4386 
4387  }

§ linemapUpdateGutter()

ctext::linemapUpdateGutter   win ptags x y  

Definition at line 4389 of file ctext.tcl.

4389  proc linemapUpdateGutter {win ptags x y} {
4390 
4391  variable data
4392 
4393  upvar $ptags tags
4394 
4395  set index 0
4396  set fontwidth $data($win,fontwidth)
4397  set font $data($win,config,-font)
4398  set fill $data($win,config,-linemapfg)
4399 
4400  foreach gutter_data $data($win,config,gutters) {
4401  if {[lindex $gutter_data 2]} { continue}
4402  foreach gutter_tag [lsearch -inline -all -glob $tags gutter:[lindex $gutter_data 0]:*] {
4403  lassign [split $gutter_tag :] dummy dummy gutter_symname gutter_sym
4404  if {$gutter_sym ne ""} {
4405  set color [expr {[info exists data($win,gutterfg,$gutter_tag)] ? $data($win,gutterfg,$gutter_tag) : $fill}]
4406  $win.l create text [expr $x + ($index * $fontwidth)] $y -anchor sw -text $gutter_sym -fill $color -font $font -tags $gutter_tag
4407  }
4408  }
4409  incr index
4410  }
4411 
4412  }

§ linemapUpdateNeeded()

ctext::linemapUpdateNeeded   win  

Definition at line 4323 of file ctext.tcl.

4323  proc linemapUpdateNeeded {win} {
4324 
4325  variable data
4326 
4327  set yview [$win yview]
4328  set lasty [lindex [$win dlineinfo end-1c] 1]
4329 
4330  if {[info exists data($win,yview)] && ($data($win,yview) eq $yview) && \
4331  [info exists data($win,lasty)] && ($data($win,lasty) eq $lasty)} {
4332  return 0
4333  }
4334 
4335  set data($win,yview) $yview
4336  set data($win,lasty) $lasty
4337 
4338  return 1
4339 
4340  }

§ matchBracket()

ctext::matchBracket   win  

Definition at line 2761 of file ctext.tcl.

2761  proc matchBracket {win} {
2762 
2763  variable data
2764 
2765  # Remove the match cursor
2766  catch { $win tag remove matchchar 1.0 end}
2767 
2768  # If we are in block cursor mode, use the previous character
2769  if {![$win cget -blockcursor] && [$win compare insert != "insert linestart"]} {
2770  set pos "insert-1c"
2771  } else {
2772  set pos insert
2773  }
2774 
2775  # If the current character is escaped, ignore the character
2776  if {[isEscaped $win $pos]} {
2777  return
2778  }
2779 
2780  # Get the current language
2781  set lang [getLang $win $pos]
2782 
2783  switch -- [$win get $pos] {
2784  "\}" { matchPair $win $lang $pos curlyL}
2785  "\{" { matchPair $win $lang $pos curlyR}
2786  "\]" { matchPair $win $lang $pos squareL}
2787  "\[" { matchPair $win $lang $pos squareR}
2788  "\)" { matchPair $win $lang $pos parenL}
2789  "\(" { matchPair $win $lang $pos parenR}
2790  ">" { matchPair $win $lang $pos angledL}
2791  "<" { matchPair $win $lang $pos angledR}
2792  "\"" { matchQuote $win $lang $pos comstr0d double}
2793  "'" { matchQuote $win $lang $pos comstr0s single}
2794  "`" { matchQuote $win $lang $pos comstr0b btick}
2795  }
2796 
2797  }

§ matchPair()

ctext::matchPair   win lang pos type  

Definition at line 2906 of file ctext.tcl.

2906  proc matchPair {win lang pos type} {
2907 
2908  variable data
2909 
2910  if {![info exists data($win,config,matchChar,$lang,[string range $type 0 end-1])] || \
2911  [inCommentString $win $pos]} {
2912  return
2913  }
2914 
2915  if {[set pos [getMatchBracket $win $type [$win index $pos]]] ne ""} {
2916  $win tag add matchchar $pos
2917  }
2918 
2919  }

§ matchQuote()

ctext::matchQuote   win lang pos tag type  

Definition at line 2921 of file ctext.tcl.

2921  proc matchQuote {win lang pos tag type} {
2922 
2923  variable data
2924 
2925  if {![info exists data($win,config,matchChar,$lang,$type)]} {
2926  return
2927  }
2928 
2929  # Get the actual tag to check for
2930  set tag [lsearch -inline [$win tag names $pos] __$tag*]
2931 
2932  lassign [$win tag nextrange $tag $pos] first last
2933 
2934  if {$first eq [$win index $pos]} {
2935  if {[$win compare $last != end]} {
2936  $win tag add matchchar "$last-1c"
2937  }
2938  } else {
2939  lassign [$win tag prevrange $tag $pos] first last
2940  if {$first ne ""} {
2941  $win tag add matchchar $first
2942  }
2943  }
2944 
2945  }

§ modified()

ctext::modified   win value ?dat?  

Definition at line 4579 of file ctext.tcl.

4579  proc modified {win value {dat ""}} {
4580 
4581  variable data
4582 
4583  set data($win,config,modified) $value
4584  event generate $win <<Modified>> -data $dat
4585 
4586  return $value
4587 
4588  }

§ prewhite()

ctext::prewhite   win start end  

Definition at line 3657 of file ctext.tcl.

3657  proc prewhite {win start end} {
3658 
3659  # Add prewhite tags
3660  set i 0
3661  set indices [list]
3662  foreach res [$win._t search -regexp -all -count lengths -- {^[ \t]*\S} $start $end] {
3663  lappend indices $res "$res+[lindex $lengths $i]c"
3664  incr i
3665  }
3666 
3667  catch { $win._t tag add __prewhite {*}$indices}
3668 
3669  }

§ redo()

ctext::redo   win  

Definition at line 1214 of file ctext.tcl.

1214  proc redo {win} {
1215 
1216  variable data
1217 
1218  if {[llength $data($win,config,redo_hist)] > 0} {
1219 
1220  set i 0
1221  set insert 0
1222  set do_tags [list]
1223  set ranges [list]
1224  set changed ""
1225 
1226  foreach element [lreverse $data($win,config,redo_hist)] {
1227 
1228  lassign $element cmd val1 val2 cursor sep
1229 
1230  switch $cmd {
1231  i {
1232  $win._t insert $val1 $val2
1233  append changed $val2
1234  set val2 [$win index "$val1+[string length $val2]c"]
1235  comments_do_tag $win.t $val1 $val2 do_tags
1236  set_rmargin $win $val1 $val2
1237  lappend data($win,config,undo_hist) [list d $val1 $val2 $cursor $sep]
1238  if {$cursor != $val2} {
1239  set cursor $val2
1240  }
1241  set insert 1
1242  }
1243  d {
1244  set str [$win get $val1 $val2]
1245  append changed $str
1246  comments_chars_deleted $win $val1 $val2 do_tags
1247  $win._t delete $val1 $val2
1248  lappend data($win,config,undo_hist) [list i $val1 $str $cursor $sep]
1249  if {$cursor != $val1} {
1250  set cursor $val1
1251  }
1252  }
1253  }
1254 
1255  $win._t tag add hl [$win._t index "$val1 linestart"] [$win._t index "$val2 lineend"]
1256 
1257  incr i
1258 
1259  if {$sep} {
1260  break
1261  }
1262 
1263  }
1264 
1265  # Get the list of affected lines that need to be re-highlighted
1266  set ranges [$win._t tag ranges hl]
1267  $win._t tag delete hl
1268 
1269  # Highlight the code
1270  if {[llength $ranges] > 0} {
1271  if {[highlightAll $win $ranges $insert $do_tags]} {
1272  checkAllBrackets $win
1273  } else {
1274  checkAllBrackets $win $changed
1275  }
1276  }
1277 
1278  set data($win,config,redo_hist) [lreplace $data($win,config,redo_hist) end-[expr $i - 1] end]
1279 
1280  # Set the sep field of the last separator field to match the number of elements added to
1281  # the undo_hist list.
1282  if {$data($win,config,undo_sep_last) >= 0} {
1283  lset data($win,config,undo_hist) $data($win,config,undo_sep_last) 4 $i
1284  }
1285 
1286  # Update undo separator structures
1287  incr data($win,config,undo_hist_size) $i
1288  set data($win,config,undo_sep_next) [expr ($data($win,config,undo_sep_next) == -1) ? [expr $data($win,config,undo_hist_size) - 1] : $data($win,config,undo_sep_next)]
1289  set data($win,config,undo_sep_last) [expr $data($win,config,undo_hist_size) - 1]
1290  incr data($win,config,undo_sep_size)
1291  incr data($win,config,undo_sep_count)
1292 
1293  ::tk::TextSetCursor $win.t $cursor
1294  modified $win 1 [list redo $ranges ""]
1295 
1296  }
1297 
1298  }

§ regexps()

ctext::regexps   win start end lang ins ptags  

Definition at line 3770 of file ctext.tcl.

3770  proc regexps {win start end lang ins ptags} {
3771 
3772  variable data
3773 
3774  if {![info exists data($win,highlight,regexps,$lang)]} return
3775 
3776  upvar $ptags tags
3777 
3778  set lines [split [$win._t get $start $end] \n]
3779  set startrow [lindex [split $start .] 0]
3780 
3781  # Handle regular expression matching
3782  foreach name $data($win,highlight,regexps,$lang) {
3783  lassign [split $name ,] dummy1 type dummy2 value
3784  lassign $data($win,highlight,$name) re re_opts immediate
3785  set i 0
3786  if {$type eq "class"} {
3787  foreach res [$win._t search -count lengths -regexp {*}$re_opts -all -nolinestop -- $re $start $end] {
3788  set wordEnd [$win._t index "$res + [lindex $lengths $i] chars"]
3789  dict lappend tags $value $res $wordEnd
3790  incr i
3791  }
3792  } else {
3793  array unset itags
3794  set row $startrow
3795  foreach line $lines {
3796  set col 0
3797  array unset var
3798  while {[regexp {*}$re_opts -indices -start $col -- $re $line var(0) var(1) var(2) var(3) var(4) var(5) var(6) var(7) var(8) var(9)] && ([lindex $var(0) 0] <= [lindex $var(0) 1])} {
3799  if {![catch { {*}$value $win $row $line [array get var] $ins} retval] && ([llength $retval] == 2)} {
3800  lassign $retval rtags goback
3801  if {([llength $rtags] % 3) == 0} {
3802  foreach {rtag rstart rend} $rtags {
3803  if {[info exists data($win,classimmediate,$rtag)]} {
3804  if {$data($win,classimmediate,$rtag)} {
3805  lappend itags(__$rtag) $row.$rstart $row.[expr $rend + 1]
3806  } else {
3807  dict lappend tags __$rtag $row.$rstart $row.[expr $rend + 1]
3808  }
3809  }
3810  }
3811  }
3812  set col [expr {($goback ne "") ? $goback : ([lindex $var(0) 1] + 1)}]
3813  } else {
3814  set col [expr {[lindex $var(0) 1] + 1}]
3815  }
3816  }
3817  incr row
3818  }
3819  foreach tag [array names itags] {
3820  $win._t tag add $tag {*}$itags($tag)
3821  }
3822  }
3823  }
3824 
3825  }

§ searches()

ctext::searches   win start end ptags  

Definition at line 3829 of file ctext.tcl.

3829  proc searches {win start end ptags} {
3830 
3831  upvar $ptags tags
3832 
3833  variable data
3834 
3835  foreach {key value} [array get data $win,highlight,searches,*] {
3836 
3837  set class [lindex [split $key ,] 3]
3838  lassign $value str opts
3839 
3840  # Perform the search now
3841  set i 0
3842  foreach res [$win._t search -count lengths {*}$opts -all -- $str $start $end] {
3843  dict lappend tags $class $res [$win._t index "$res + [lindex $lengths $i] chars"]
3844  incr i
3845  }
3846 
3847  }
3848 
3849  }

§ set_border_color()

ctext::set_border_color   win color  

Definition at line 905 of file ctext.tcl.

905  proc set_border_color {win color} {
906 
907  __ctextJunk$win configure -bg $color
908 
909  }

§ set_rmargin()

ctext::set_rmargin   win startpos endpos  

Definition at line 4552 of file ctext.tcl.

4552  proc set_rmargin {win startpos endpos} {
4553 
4554  $win tag add rmargin $startpos $endpos
4555  $win tag add lmargin $startpos $endpos
4556 
4557  }

§ set_warnwidth()

ctext::set_warnwidth   win ?adjust?  

Definition at line 4534 of file ctext.tcl.

4534  proc set_warnwidth {win {adjust 0}} {
4535 
4536  variable data
4537 
4538  if {$data($win,config,-warnwidth) eq ""} {
4539  place forget $win.t.w
4540  return
4541  }
4542 
4543  set lmargin $data($win,config,-lmargin)
4544  set cwidth [font measure [$win._t cget -font] -displayof . m]
4545  set str [string repeat "m" $data($win,config,-warnwidth)]
4546  set newx [expr $lmargin + ($cwidth * $data($win,config,-warnwidth)) + $adjust]
4547  place configure $win.t.w -x $newx -relheight 1.0
4548  adjust_rmargin $win
4549 
4550  }

§ setAutoMatchChars()

ctext::setAutoMatchChars   win lang matchChars  

Definition at line 2734 of file ctext.tcl.

2734  proc setAutoMatchChars {win lang matchChars} {
2735 
2736  variable data
2737 
2738  # Clear the matchChars
2739  catch { array unset data $win,config,matchChar,$lang,*}
2740 
2741  # Remove the brackets
2742  foreach type [list curly square paren angled] {
2743  catch { $win._t tag delete missing:$type}
2744  }
2745 
2746  # Set the matchChars
2747  foreach matchChar $matchChars {
2748  set data($win,config,matchChar,$lang,$matchChar) 1
2749  }
2750 
2751  # Set the bracket auditing tags
2752  foreach matchChar [list curly square paren angled] {
2753  if {[info exists data($win,config,matchChar,$lang,$matchChar)]} {
2754  $win._t tag configure missing:$matchChar -background $data($win,config,-matchaudit_bg)
2755  $win._t tag raise missing:$matchChar _visibleH
2756  }
2757  }
2758 
2759  }

§ setIndentation()

ctext::setIndentation   twin lang indentations type  

Definition at line 3627 of file ctext.tcl.

3627  proc setIndentation {twin lang indentations type} {
3628 
3629  variable data
3630 
3631  if {[llength $indentations] > 0} {
3632  set data($twin,config,indentation,$lang,$type) [join $indentations |]
3633  $twin tag configure __$type
3634  $twin tag lower __$type _invisible
3635  } else {
3636  catch { unset data($twin,config,indentation,$lang,$type)}
3637  }
3638 
3639  }

§ undo()

ctext::undo   win  

Definition at line 1121 of file ctext.tcl.

1121  proc undo {win} {
1122 
1123  variable data
1124 
1125  # puts "START undo"
1126  # undo_display $win
1127 
1128  if {[llength $data($win,config,undo_hist)] > 0} {
1129 
1130  set i 0
1131  set last_cursor 1.0
1132  set insert 0
1133  set ranges [list]
1134  set do_tags [list]
1135  set changed ""
1136  set sep_dec 0
1137 
1138  foreach element [lreverse $data($win,config,undo_hist)] {
1139 
1140  lassign $element cmd val1 val2 cursor sep
1141 
1142  if {$sep} {
1143  if {$i == 0} {
1144  set sep_dec -1
1145  } else {
1146  break
1147  }
1148  }
1149 
1150  switch $cmd {
1151  i {
1152  $win._t insert $val1 $val2
1153  append changed $val2
1154  set val2 [$win index "$val1+[string length $val2]c"]
1155  comments_do_tag $win $val1 $val2 do_tags
1156  set_rmargin $win $val1 $val2
1157  lappend data($win,config,redo_hist) [list d $val1 $val2 $cursor $sep]
1158  set insert 1
1159  }
1160  d {
1161  set str [$win get $val1 $val2]
1162  append changed $str
1163  comments_chars_deleted $win $val1 $val2 do_tags
1164  $win._t delete $val1 $val2
1165  lappend data($win,config,redo_hist) [list i $val1 $str $cursor $sep]
1166  }
1167  }
1168 
1169  $win._t tag add hl [$win._t index "$val1 linestart"] [$win._t index "$val2 lineend"]
1170 
1171  set last_cursor $cursor
1172 
1173  incr i
1174 
1175  }
1176 
1177  # Get the list of affected lines that need to be re-highlighted
1178  set ranges [$win._t tag ranges hl]
1179  $win._t tag delete hl
1180 
1181  # Perform the highlight
1182  if {[llength $ranges] > 0} {
1183  if {[highlightAll $win $ranges $insert $do_tags]} {
1184  checkAllBrackets $win
1185  } else {
1186  checkAllBrackets $win $changed
1187  }
1188  }
1189 
1190  set data($win,config,undo_hist) [lreplace $data($win,config,undo_hist) end-[expr $i - 1] end]
1191  incr data($win,config,undo_hist_size) [expr 0 - $i]
1192 
1193  # Set the last sep of the undo_hist list to -1 to indicate the end of the list
1194  if {$data($win,config,undo_hist_size) > 0} {
1195  lset data($win,config,undo_hist) end 4 -1
1196  }
1197 
1198  # Update undo separator info
1199  set data($win,config,undo_sep_next) [expr ($data($win,config,undo_hist_size) == 0) ? -1 : $data($win,config,undo_sep_next)]
1200  set data($win,config,undo_sep_last) [expr $data($win,config,undo_hist_size) - 1]
1201  incr data($win,config,undo_sep_size) -1
1202  incr data($win,config,undo_sep_count) $sep_dec
1203 
1204  ::tk::TextSetCursor $win.t $last_cursor
1205  modified $win 1 [list undo $ranges ""]
1206 
1207  }
1208 
1209  # puts "END undo"
1210  # undo_display $win
1211 
1212  }

§ undo_delete()

ctext::undo_delete   win start_pos end_pos  

Definition at line 1051 of file ctext.tcl.

1051  proc undo_delete {win start_pos end_pos} {
1052 
1053  variable data
1054 
1055  if {!$data($win,config,-undo)} {
1056  return
1057  }
1058 
1059  # puts "START undo_delete, start_pos: $start_pos, end_pos: $end_pos"
1060  # undo_display $win
1061 
1062  set str [$win get $start_pos $end_pos]
1063 
1064  # Combine elements, if possible
1065  if {[llength $data($win,config,undo_hist)] > 0} {
1066  lassign [lindex $data($win,config,undo_hist) end] cmd val1 val2 cursor sep
1067  if {$sep == 0} {
1068  if {$cmd eq "i"} {
1069  if {$val1 eq $end_pos} {
1070  lset data($win,config,undo_hist) end 1 $start_pos
1071  lset data($win,config,undo_hist) end 2 "$str$val2"
1072  set data($win,config,redo_hist) [list]
1073  return
1074  } elseif {$val1 eq $start_pos} {
1075  lset data($win,config,undo_hist) end 2 "$val2$str"
1076  set data($win,config,redo_hist) [list]
1077  return
1078  }
1079  } elseif {($cmd eq "d") && ($val2 eq $end_pos)} {
1080  lset data($win,config,undo_hist) end 2 $start_pos
1081  lset data($win,config,redo_hist) [list]
1082  return
1083  }
1084  }
1085  }
1086 
1087  # Add to the undo history
1088  lappend data($win,config,undo_hist) [list i $start_pos $str [$win index insert] 0]
1089  incr data($win,config,undo_hist_size)
1090 
1091  # Clear the redo history
1092  set data($win,config,redo_hist) [list]
1093 
1094  # puts "END undo_delete"
1095  # undo_display $win
1096 
1097  }

§ undo_display()

ctext::undo_display   win  

Definition at line 921 of file ctext.tcl.

921  proc undo_display {win} {
922 
923  variable data
924 
925  puts "Undo History (size: $data($win,config,undo_hist_size), sep_size: $data($win,config,undo_sep_size)):"
926 
927  for {set i 0} {$i < $data($win,config,undo_hist_size)} {incr i} {
928  puts -nonewline " [lindex $data($win,config,undo_hist) $i] "
929  if {$data($win,config,undo_sep_next) == $i} {
930  puts -nonewline " sep_next"
931  }
932  if {$data($win,config,undo_sep_last) == $i} {
933  puts -nonewline " sep_last"
934  }
935  puts ""
936  }
937 
938  }

§ undo_get_cursor_hist()

ctext::undo_get_cursor_hist   win  

Definition at line 1099 of file ctext.tcl.

1099  proc undo_get_cursor_hist {win} {
1100 
1101  variable data
1102 
1103  set cursors [list]
1104 
1105  if {[set index $data($win,config,undo_sep_next)] != -1} {
1106 
1107  set sep 0
1108 
1109  while {$sep != -1} {
1110  lassign [lindex $data($win,config,undo_hist) $index] cmd val1 val2 cursor sep
1111  lappend cursors $cursor
1112  incr index $sep
1113  }
1114 
1115  }
1116 
1117  return $cursors
1118 
1119  }

§ undo_insert()

ctext::undo_insert   win insert_pos str_len cursor  

Definition at line 1014 of file ctext.tcl.

1014  proc undo_insert {win insert_pos str_len cursor} {
1015 
1016  variable data
1017 
1018  if {!$data($win,config,-undo)} {
1019  return
1020  }
1021 
1022  # puts "START undo_insert, insert_pos: $insert_pos, str_len: $str_len, cursor: $cursor"
1023  # undo_display $win
1024 
1025  set end_pos [$win index "$insert_pos+${str_len}c"]
1026 
1027  # Combine elements, if possible
1028  if {[llength $data($win,config,undo_hist)] > 0} {
1029  lassign [lindex $data($win,config,undo_hist) end] cmd val1 val2 hcursor sep
1030  if {$sep == 0} {
1031  if {($cmd eq "d") && ($val2 eq $insert_pos)} {
1032  lset data($win,config,undo_hist) end 2 $end_pos
1033  set data($win,config,redo_hist) [list]
1034  return
1035  }
1036  }
1037  }
1038 
1039  # Add to the undo history
1040  lappend data($win,config,undo_hist) [list d $insert_pos $end_pos $cursor 0]
1041  incr data($win,config,undo_hist_size)
1042 
1043  # Clear the redo history
1044  set data($win,config,redo_hist) [list]
1045 
1046  # puts "END undo_insert"
1047  # undo_display $win
1048 
1049  }

§ undo_manage()

ctext::undo_manage   win  

Definition at line 982 of file ctext.tcl.

982  proc undo_manage {win} {
983 
984  variable data
985 
986  # If we need to make the undo history list shorter
987  if {($data($win,config,-maxundo) > 0) && ([set to_remove [expr $data($win,config,undo_sep_size) - $data($win,config,-maxundo)]] > 0)} {
988 
989  # Get the separators to remove
990  set index $data($win,config,undo_sep_next)
991  for {set i 1} {$i < $to_remove} {incr i} {
992  incr index [lindex $data($win,config,undo_hist) $index 4]
993  }
994 
995  # Set the next separator index
996  set data($win,config,undo_sep_next) [expr [lindex $data($win,config,undo_hist) $index 4] - 1]
997 
998  # Reset the last separator index
999  set data($win,config,undo_sep_last) [expr $data($win,config,undo_sep_last) - ($index + 1)]
1000 
1001  # Set the separator size
1002  incr data($win,config,undo_sep_size) [expr 0 - $to_remove]
1003 
1004  # Shorten the undo history list
1005  set data($win,config,undo_hist) [lreplace $data($win,config,undo_hist) 0 $index]
1006 
1007  # Set the undo history size
1008  incr data($win,config,undo_hist_size) [expr 0 - ($index + 1)]
1009 
1010  }
1011 
1012  }

§ undo_separator()

ctext::undo_separator   win  

Definition at line 940 of file ctext.tcl.

940  proc undo_separator {win} {
941 
942  variable data
943 
944  # puts "START undo_separator"
945  # undo_display $win
946 
947  # If a separator is being added (and it was not already added), add it
948  if {$data($win,config,undo_sep_last) != ($data($win,config,undo_hist_size) - 1)} {
949 
950  # Set the separator
951  lset data($win,config,undo_hist) end 4 -1
952 
953  # Get the last index of the undo history list
954  set last_index [expr $data($win,config,undo_hist_size) - 1]
955 
956  # Add the separator
957  if {$data($win,config,undo_sep_next) == -1} {
958  set data($win,config,undo_sep_next) $last_index
959  } else {
960  lset data($win,config,undo_hist) $data($win,config,undo_sep_last) 4 [expr $last_index - $data($win,config,undo_sep_last)]
961  }
962 
963  # Set the last separator index
964  set data($win,config,undo_sep_last) $last_index
965 
966  # Increment the separator size
967  incr data($win,config,undo_sep_size)
968 
969  # Increment the separator count
970  incr data($win,config,undo_sep_count)
971 
972  }
973 
974  # If the number of separators exceeds the maximum length, shorten the undo history list
975  undo_manage $win
976 
977  # puts "END undo_separator"
978  # undo_display $win
979 
980  }

§ update_linemap_separator()

ctext::update_linemap_separator   win  

Definition at line 655 of file ctext.tcl.

655  proc update_linemap_separator {win} {
656 
657  variable data
658 
659  # If the linemap is not being displayed, return now
660  if {[lsearch [grid slaves $win] $win.l] == -1} {
661  return
662  }
663 
664  switch $data($win,config,-linemap_separator) {
665  1 -
666  yes -
667  true {
668  grid $win.f
669  }
670  auto {
671  catch {
672  set lm [winfo rgb $win $data($win,config,-linemapbg)]
673  set bg [winfo rgb $win $data($win,config,-background)]
674  if {$lm ne $bg} {
675  grid $win.f
676  } else {
677  grid remove $win.f
678  }
679  }
680  }
681  default {
682  grid remove $win.f
683  }
684  }
685 
686  }

§ updateLangBackgrounds()

ctext::updateLangBackgrounds   win  

Definition at line 3610 of file ctext.tcl.

3610  proc updateLangBackgrounds {win} {
3611 
3612  variable data
3613 
3614  foreach lang $data($win,config,langs) {
3615  set indices [list]
3616  foreach {start end} [$win._t tag ranges __Lang:$lang] {
3617  if {[$win compare "$start+1l linestart" < "$end linestart"]} {
3618  lappend indices "$start+1l linestart" "$end linestart"
3619  }
3620  }
3621  catch { $win._t tag remove __Lang=$lang 1.0 end}
3622  catch { $win._t tag add __Lang=$lang {*}$indices}
3623  }
3624 
3625  }

§ updateMetaChars()

ctext::updateMetaChars   win  

Definition at line 3853 of file ctext.tcl.

3853  proc updateMetaChars {win} {
3854 
3855  variable data
3856 
3857  set value $data($win,config,-hidemeta)
3858 
3859  foreach tag $data($win,config,meta_classes) {
3860  $win._t tag configure __$tag -elide $value
3861  }
3862 
3863  }

§ words()

ctext::words   win start end lang ins ptags  

Definition at line 3729 of file ctext.tcl.

3729  proc words {win start end lang ins ptags} {
3730 
3731  upvar $ptags tags
3732 
3733  variable data
3734 
3735  set retval ""
3736 
3737  if {[llength [array names data $win,highlight,w*,$lang,*]] > 0} {
3738 
3739  set row [lindex [split $start .] 0]
3740  foreach line [split [$win._t get $start $end] \n] {
3741  set col 0
3742  while {[regexp -indices -start $col -- $data($win,config,-delimiters) $line res]} {
3743  lassign $res scol ecol
3744  set word [string range $line $scol $ecol]
3745  set col [expr $ecol + 1]
3746  if {!$data($win,config,-casesensitive)} {
3747  set word [string tolower $word]
3748  }
3749  set firstOfWord [string index $word 0]
3750  if {[info exists data($win,highlight,wkeyword,class,$lang,$word)]} {
3751  dict lappend tags $data($win,highlight,wkeyword,class,$lang,$word) $row.$scol $row.$col
3752  } elseif {[info exists data($win,highlight,wcharstart,class,$lang,$firstOfWord)]} {
3753  dict lappend tags $data($win,highlight,wcharstart,class,$lang,$firstOfWord) $row.$scol $row.$col
3754  }
3755  if {[info exists data($win,highlight,wkeyword,command,$lang,$word)] && \
3756  ![catch { {*}$data($win,highlight,wkeyword,command,$lang,$word) $win $row $line [list 0 [list $scol $ecol]] $ins} retval] && ([llength $retval] == 3)} {
3757  dict lappend tags [lindex $retval 0] $row.[lindex $retval 1] $row.[expr [lindex $retval 2] + 1]
3758  } elseif {[info exists data($win,highlight,wcharstart,command,$lang,$firstOfWord)] && \
3759  ![catch { {*}$data($win,highlight,wcharstart,command,$lang,$firstOfWord) $win $row $line [list 0 [list $scol $ecol]] $ins} retval] && ([llength $retval] == 3)} {
3760  dict lappend tags [lindex $retval 0] $row.[lindex $retval 1] $row.[expr [lindex $retval 2] + 1]
3761  }
3762  }
3763  incr row
3764  }
3765 
3766  }
3767 
3768  }