::hl_tclTop

The hl_tcl package is a syntax highlighter for Tcl/Tk code.

It can be applied to a Tk text widget or to a static html page.

The Tk text widget may be made read-only or editable. Also, the hl_tcl may take an argument, sort of command to watch the viewing / editing.

When applied to html pages, the hl_tcl highlights Tcl/Tk code snippets embedded between <code> </code> tags.

The hl_tcl has highlighted its own code in Reference.


Some of blah-blahhl_tcl, Top

The Tcl being incredibly dynamic language sets a lot of problems before any Tcl syntax highlighter. Probably, the usage of quotes and esp. the strings spanning several lines are the main challenges.

Below is a line that brings most (not hl_tcl, as seen in Reference) of Tcl highlighters in a stupor:


if {[set i [string first {"} $line $i]]==-1} {return no}

... as well as this one:


regsub -all {(([^A-Z@]|\\@)[.?!]("|'|'')?([])])?) } $fieldText {\1 } fieldText

Good luck for a highlighter when the second line (or similar) follows the first, giving it a matching quote and thus bringing it out of the stupor.

Those orphan quotes are often used in regexp and regsub Tcl commands, so that when a honest Tcl highlighter (like Geany) stumbles upon an orphan quote, it tries its best to highlight the rest of code as a string, till the next unmatched quote.

Thus, we have

... instead of

There are "tricky" highlighters (like Gedit) that behave more wisely at the stumbling an orphan quote: they permit only a one-line Tcl strings (if not continued with \), so that the string highlighting would be most likely finished in the same line it started. No problems except for this silly line. And no delays due to the highlighting the rest of code...

... as seen in:


Some of editorshl_tcl, Top

Geany. Probably, the best Tcl highlighter. And the great programming tool at that. Still, it has few drawbacks:

  • doesn't highlight the above mentioned Tcl lines properly
  • doesn't highlight ${var} in contrast with $var
  • tries to highlight any (even hexidecimal) number it encounters, thus set a 1fix or set b #abxxx looks a bit peculiar
  • set c {#000000 #FFFFFF} is quite a legal Tcl command, not for Geany
  • no highlighting TclOO (method, mixin, my etc.)

Vim. Probably, the fastest Tcl highlighter. Great and awful. Nonetheless:

  • tricky with those above mentioned Tcl lines
  • doesn't highlight ttk commands (Tk only) and TclOO
  • tries to highlight every bit of Tcl, e.g. set set set is highlighted as three set commands ;)
  • as a result, much more florid than most of others

Kate. As nearly good as Geany. As nearly florid as Vim (set set set). Doesn't highlight ttk and TclOO.

TKE. Written in Tcl/Tk, it might be the best of all to highlight the Tcl/Tk. In spite of its suspended state it still can. Issues with highlighting strings and the performance.

Pluma and Gedit seem to use the same Tcl highlighting engine that gives rather good results. Still, the mentioned above drawbacks are here too. And no highlighting of tk, ttk, TclOO.

Notepad++. Very fast Tcl highlighter. And very basic. All the same drawbacks. No highlighting of tk, ttk, TclOO. Plus an obsolete version of Tcl, i.e. no highlighting lset, lassign etc.


What can we do?hl_tcl, Top

To develop an ideal (correct and fast) Tcl/Tk highlighter, we would have to dive into Tcl core. Though, no hopes to achieve the ideal through repeating the core in Tcl/Tk or massively using the regular expressions.

That said, while implementing Tcl/Tk highlighter in pure Tcl/Tk, we might hope to achieve a reasonable compromise between the performance and the elimination of blunders.

It seems hl_tcl got close to this compromise. Specifically, it provides:

  • special highlighting for Tcl and TclOO commands
  • special highlighting for Tk and ttk commands
  • special highlighting for declarations proc, method, oo::class etc. as well as return, yield
  • special highlighting for #comments, $variables, "strings", -options
  • in-line comments being recognized and thus highlighted only after ;#
  • proper handling of most regexp and regsub expressions containing a quote
  • highlighting the multi-line strings, with possible switching this mode off (a-la Gedit) to improve the performance
  • customizing colors of the highlighting
  • highlighting viewable/editable Tk text widget and static html pages
  • good performance at editing 1000-4000 LOC and rather acceptable for 4000-9000 LOC
  • even monstrous 10000 LOC and more are handled fast at the "tricky" mode a-la Gedit

The hl_tcl doesn't provide the following:

  • highlighting numbers
  • highlighting brackets, except for matched ones and inside the strings

These are in no way critical drawbacks. A little less florid Tcl code might be even preferable for other tastes.

The Tcl can arrange its pitfalls for hl_tcl (I know where). Also, tricky practices or tastes can make a fool of hl_tcl. Still hopefully these pranks are few and rare to encounter.


Use for text widgethl_tcl, Top

The code below:


package require hl_tcl proc ::stub {args} {puts "stub: $args"} ::hl_tcl::hl_init $::txt -readonly yes -cmd ::stub #... inserting a text into the text widget ::hl_tcl::hl_text $::txt

sets an example of hl_tcl usage. Here are the details:

  • ::stub is a procedure to watch the text editing; here it simply puts out the text's last index;
  • hl_init is called before filling the text widget with a Tcl code; it sets the highlighting options and disables the highlighting till hl_text runs;
  • hl_text runs to highlight the Tcl code of the text widget and to view/edit it.

The hl_init takes arguments:

  • txt is the text widget's path
  • args contains options of text widget (omittable)

The args is a list of -option "value" where -option may be:

  • -colors - list of colors: clrCOM, clrCOMTK, clrSTR, clrVAR, clrCMN, clrPROC, clrOPT
  • -dark - flag "dark background of text", i.e. simplified -colors (default "no")
  • -font - attributes of text font
  • -readonly - flag "text is read-only" (default "no")
  • -multiline - flag "multi-line strings" (default "yes")
  • -cmd - command to watch editing/viewing (default "")
  • -cmdpos - command to watch cursor positioning (default "")
  • -seen - number of first lines seen at start (default 500)
  • -optRE - flag "use a regular expression to highlight options" (default "yes")

Note: -seen 500 and -multiline no can improve the performance a lot. It's recommended to use -seen 500 (or any other reasonable limit, e.g. -seen 200) at any rate, except for static html pages.

The rest of hl_tcl procedures are:

  • hl_all updates all highlighted existing text widgets, e.g. at changing a color scheme of application
  • hl_readonly gets/sets a read-only mode and/or a command to watch a text widget at viewing/editing it
  • hl_colors gets a list of colors for highlighting

See details in Reference.


Use for static htmlhl_tcl, Top

In the hl_tcl.zip, there is a Tcl script named tcl_html.tcl that highlights Tcl snippets of static html page(s).

It runs as follows:


tclsh tcl_html.tcl "glob-pattern-of-html-files"

For example:


tclsh ~/UTILS/hl_tcl/tcl_html.tcl "~/UTILS/mulster/tasks/ruff/src/*"

In this example, the html files are located in ~/UTILS/mulster/tasks/ruff/src.

Perhaps, you would want to modify the tcl_html.tcl, this way:

  • replace "no" with "yes" for dark html pages
  • replace <code class="tcl"> with html tags starting the Tcl code in your html files
  • replace </code> with html tags finishing the Tcl code in your html files

These are arguments of ::hl_tcl_html::highlight procedure.

The tag pairs can be multiple if the html pages contain them, e.g.


::hl_tcl_html::highlight $fhtml "no" {<code class="tcl">} {</code>} {<pre class="code">} {</pre>}

Linkshl_tcl, Top

Note that hl_tcl is still disposed to update.


Commandshl_tcl, Top




hl_all [::hl_tcl]hl_tcl, Top

Updates ("rehighlights") all highlighted and existing text widgets.

hl_all ?args?
Parameters
argsdict of options
See also

hl_init


proc ::hl_tcl::hl_all {args} { # Updates ("rehighlights") all highlighted and existing text widgets. # args - dict of options # See also: hl_init if {[info exists ::hl_tcl::my::data(LIST_TXT)]} { foreach wattrs $::hl_tcl::my::data(LIST_TXT) { lassign $wattrs txt ro com2 if {[winfo exists $txt]} { if {![info exists ::hl_tcl::my::data(SETCOLORS,$txt)]} { unset ::hl_tcl::my::data(COLORS,$txt) ;# colors defined by DARK } # args (if set) override the appropriate settings for $txt hl_init $txt -- {*}$args hl_text $txt } } } }




hl_colorNames [::hl_tcl]hl_tcl, Top

Returns a list of color names for syntax highlighting.

hl_colorNames
Return value

Returns a list of color names for syntax highlighting.


proc ::hl_tcl::hl_colorNames {} { # Returns a list of color names for syntax highlighting. return [list clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT clrBRA] }




hl_colors [::hl_tcl]hl_tcl, Top

Gets/sets the main colors for highlighting (except for "curr.line").

hl_colors txt ?dark? ?args?
Parameters
txttext widget's path
darkflag "dark scheme" optional, default ""
argsa list of colors to set for txt
Return value

Returns a list of colors for COM COMTK STR VAR CMN PROC OPT BRAC or, if the colors aren't initialized, "standard" colors.


proc ::hl_tcl::hl_colors {txt {dark {}} args} { # Gets/sets the main colors for highlighting (except for "curr.line"). # txt - text widget's path # dark - flag "dark scheme" # args - a list of colors to set for *txt* # Returns a list of colors for COM COMTK STR VAR CMN PROC OPT BRAC or, if the colors aren't initialized, "standard" colors. if {[llength $args]} { set ::hl_tcl::my::data(COLORS,$txt) $args return } if {[info exists ::hl_tcl::my::data(COLORS,$txt)]} { return $::hl_tcl::my::data(COLORS,$txt) } if {$dark eq {}} {set dark $::hl_tcl::my::data(DARK,$txt)} if {$dark} { return [list orange #ff7e00 lightgreen #f1b479 #76a396 #d485d4 #b9b96e #ff33ff] } else { return [list #923B23 #7d1c00 #035103 #4A181B #505050 #A106A1 #463e11 #FF0000] } }




hl_init [::hl_tcl]hl_tcl, Top

Initializes highlighting.

hl_init txt ?args?
Parameters
txttext widget's path
argsdict of options
Description

The 'args' options include:

--means that only args' options will be initialized (defaults skipped)
-darkflag "the text widget has dark background"
-readonlyflag "read-only"
-optREflag "use of RE to highlight options"
-multilineflag "allowed multi-line strings"
-cmdcommand to watch editing/viewing
-cmdposcommand to watch cursor positioning
-colorslist of colors: clrCOM, clrCOMTK, clrSTR, clrVAR, clrCMN, clrPROC
-fontattributes of font
-seenlines seen at start
-keywordsadditional commands to highlight (as Tk ones)

This procedure has to be called before writing a text in the text widget.


proc ::hl_tcl::hl_init {txt args} { # Initializes highlighting. # txt - text widget's path # args - dict of options # The 'args' options include: # -- - means that only args' options will be initialized (defaults skipped) # -dark - flag "the text widget has dark background" # -readonly - flag "read-only" # -optRE - flag "use of RE to highlight options" # -multiline - flag "allowed multi-line strings" # -cmd - command to watch editing/viewing # -cmdpos - command to watch cursor positioning # -colors - list of colors: clrCOM, clrCOMTK, clrSTR, clrVAR, clrCMN, clrPROC # -font - attributes of font # -seen - lines seen at start # -keywords - additional commands to highlight (as Tk ones) # This procedure has to be called before writing a text in the text widget. if {[set setonly [expr {[lindex $args 0] eq {--}}]]} { set args [lrange $args 1 end] } set ::hl_tcl::my::data(REG_TXT,$txt) {} ;# disables Modified at changing the text set ::hl_tcl::my::data(KEYWORDS,$txt) {} foreach {opt val} {-dark 0 -readonly 0 -cmd {} -cmdpos {} -optRE 1 -multiline 1 -seen 500 -plaintext no -insertwidth 2 -keywords {}} { if {[dict exists $args $opt]} { set val [dict get $args $opt] } elseif {$setonly} { continue ;# only those set in args are taken into account } set ::hl_tcl::my::data([string toupper [string range $opt 1 end]],$txt) $val } set ::hl_tcl::my::data(CMD_TK_EXP) [lsort [list {*}$::hl_tcl::my::data(CMD_TK) {*}$::hl_tcl::my::data(KEYWORDS,$txt)]] unset ::hl_tcl::my::data(KEYWORDS,$txt) if {[dict exists $args -colors]} { set ::hl_tcl::my::data(COLORS,$txt) [dict get $args -colors] set ::hl_tcl::my::data(SETCOLORS,$txt) 1 } else { if {![info exists ::hl_tcl::my::data(COLORS,$txt)]} { set clrCURL {} catch {set clrCURL [lindex [::apave::obj csGet] 16]} if {$::hl_tcl::my::data(DARK,$txt)} { if {$clrCURL eq {}} {set clrCURL #29383c} set ::hl_tcl::my::data(COLORS,$txt) [list {*}[hl_colors $txt] $clrCURL] } else { if {$clrCURL eq {}} {set clrCURL #efe0cd} set ::hl_tcl::my::data(COLORS,$txt) [list {*}[hl_colors $txt] $clrCURL] } } } if {!$setonly} { if {[dict exists $args -font]} { set ::hl_tcl::my::data(FONT,$txt) [dict get $args -font] } else { set ::hl_tcl::my::data(FONT,$txt) [font actual TkFixedFont] } } if {!$setonly || [dict exists $args -readonly]} { hl_readonly $txt $::hl_tcl::my::data(READONLY,$txt) } if {[string first ::hl_tcl:: [bind $txt]]<0} { bind $txt <FocusIn> [list + ::hl_tcl::my::ShowCurrentLine $txt] } set ::hl_tcl::my::data(_INSPOS_,$txt) {} my::MemPos $txt }




hl_line [::hl_tcl]hl_tcl, Top

Updates a current line's highlighting.

hl_line txt
Parameters
txttext's path

proc ::hl_tcl::hl_line {txt} { # Updates a current line's highlighting. # txt - text's path if {!$::hl_tcl::my::data(PLAINTEXT,$txt)} { set tSTR [$txt tag ranges tagSTR] set tCMN [$txt tag ranges tagCMN] set ln0 [expr {int([$txt index insert])}] set ln2 [expr {int([$txt index end])}] set ln1 [expr {max (1,$ln0-1)}] set ln2 [expr {min ($ln2,$ln0+1)}] # update lines: previous, current, next ::hl_tcl::my::RunCoroAfterIdle $txt $ln1 $ln2 no } ::hl_tcl::my::MemPos $txt yes $txt configure -insertwidth $::hl_tcl::my::data(INSERTWIDTH,$txt) }




hl_readonly [::hl_tcl]hl_tcl, Top

Makes the text widget be readonly or gets its 'read-only' state.

hl_readonly txt ?ro? ?com2?
Parameters
txttext widget's path
roflag "the text widget is readonly" optional, default -1
com2command to be called at viewing and after changes; optional, default ""
Description

If 'ro' argument is omitted, returns the widget's 'read-only' state.


proc ::hl_tcl::hl_readonly {txt {ro -1} {com2 {}}} { # Makes the text widget be readonly or gets its 'read-only' state. # txt - text widget's path # ro - flag "the text widget is readonly" # com2 - command to be called at viewing and after changes # If 'ro' argument is omitted, returns the widget's 'read-only' state. if {$ro==-1} { return [expr {[info exists ::hl_tcl::my::data(READONLY,$txt)] && $::hl_tcl::my::data(READONLY,$txt)}] } set ::hl_tcl::my::data(READONLY,$txt) $ro if {$com2 ne {}} {set ::hl_tcl::my::data(CMD,$txt) $com2} set newcom "::$txt.internal" if {[info commands $newcom] eq ""} {rename $txt $newcom} set com "[namespace current]::my::Modified $txt" #if {$com2 ne ""} {append com " ; $com2"} if {$ro} {proc ::$txt {args} " switch -exact -- \[lindex \$args 0\] \{ insert \{$com2\} delete \{$com2\} replace \{$com2\} default \{ return \[eval $newcom \$args\] \} \}" } else {proc ::$txt {args} " switch -exact -- \[lindex \$args 0\] \{ delete \{$com {*}\$args\} insert \{$com {*}\$args\} replace \{$com {*}\$args\} \} ; set _res_ \[eval $newcom \$args\] ; return \$_res_" } }




hl_text [::hl_tcl]hl_tcl, Top

Highlights Tcl code of a text widget.

hl_text txt
Parameters
txttext widget's path

proc ::hl_tcl::hl_text {txt} { # Highlights Tcl code of a text widget. # txt - text widget's path set font0 $::hl_tcl::my::data(FONT,$txt) set font1 [set font2 $font0] $txt tag configure tagSTD -font "$font0" $txt tag add tagSTD 1.0 end dict set font1 -weight bold dict set font2 -slant italic lassign $::hl_tcl::my::data(COLORS,$txt) clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT clrBRA clrCURL $txt tag configure tagCOM -font "$font1" -foreground $clrCOM $txt tag configure tagCOMTK -font "$font1" -foreground $clrCOMTK $txt tag configure tagSTR -font "$font0" -foreground $clrSTR $txt tag configure tagVAR -font "$font0" -foreground $clrVAR $txt tag configure tagCMN -font "$font2" -foreground $clrCMN $txt tag configure tagPROC -font "$font1" -foreground $clrPROC $txt tag configure tagOPT -font "$font0" -foreground $clrOPT $txt tag configure tagBRACKET -font "$font0" -foreground $clrBRA $txt tag configure tagBRACKETERR -font "$font0" -foreground white -background red $txt tag configure tagCURLINE -background $clrCURL $txt tag raise sel $txt tag raise tagBRACKETERR catch {$txt tag raise hilited; $txt tag raise hilited2} ;# for apave package my::HighlightAll $txt if {![info exists ::hl_tcl::my::data(BIND_TXT,$txt)]} { bind $txt <FocusIn> [list + ::hl_tcl::my::MemPos $txt] bind $txt <KeyPress> [list + ::hl_tcl::my::MemPos1 $txt yes %K %s] bind $txt <KeyRelease> [list + ::hl_tcl::my::MemPos $txt] bind $txt <ButtonRelease-1> [list + ::hl_tcl::my::MemPos $txt] foreach ev {Enter KeyRelease ButtonRelease-1} { bind $txt <$ev> [list + ::hl_tcl::my::HighlightBrackets $txt] } set ::hl_tcl::my::data(BIND_TXT,$txt) yes } set ro $::hl_tcl::my::data(READONLY,$txt) set com2 $::hl_tcl::my::data(CMD,$txt) set txtattrs [list $txt $ro $com2] if {![info exists ::hl_tcl::my::data(LIST_TXT)] || [set i [lsearch -index 0 -exact $::hl_tcl::my::data(LIST_TXT) $txt]]==-1} { lappend ::hl_tcl::my::data(LIST_TXT) $txtattrs } else { set ::hl_tcl::my::data(LIST_TXT) [lreplace $::hl_tcl::my::data(LIST_TXT) $i $i $txtattrs] } hl_readonly $txt $ro $com2 }



::hl_tcl::myTop

The ::hl_tcl::my namespace contains procedures for the "internal" usage by hl_tcl package.

All of them are upper-cased, in contrast with the UI procedures of hl_tcl namespace.


Commandsmy, Top




AuxEnding [::hl_tcl::my]my, Top

Auxiliary procedure to process the ending comments in the line.

AuxEnding kName lineName iName
Parameters
kNamevariable's name for 'k'
lineNamevariable's name for 'line'
iNamevariable's name for 'i'
See also

HighlightLine


proc ::hl_tcl::my::AuxEnding {kName lineName iName} { # Auxiliary procedure to process the ending comments in the line. # kName - variable's name for 'k' # lineName - variable's name for 'line' # iName - variable's name for 'i' # See also: HighlightLine upvar 1 $kName k $lineName line $iName i if {[set k [string first # $line $i]]>-1 && [string index [string trimleft $line] 0] eq {#}} { return 1 } # not found a full line comment => try to find "good" ending comments i.e. ";# ..." # at that even proper comments like # if {cond} { #... # } # are skipped as "bad" set k [lindex [regexp -inline -indices {;\s*#} [string range $line $i end]] 0 0] if {$k eq {}} { set k -1 return 0 } set k [expr {$k+$i+1}] return 1 }




CoroHighlightAll [::hl_tcl::my]my, Top

Highlights all of a text as a coroutine.

CoroHighlightAll txt
Parameters
txttext widget's path
See also

HighlightAll


proc ::hl_tcl::my::CoroHighlightAll {txt} { # Highlights all of a text as a coroutine. # txt - text widget's path # See also: HighlightAll variable data catch { ;# $txt may be destroyed, so catch this if {!$data(PLAINTEXT,$txt)} { set tlen [lindex [split [$txt index end] .] 0] RemoveTags $txt 1.0 end set maxl [expr {min($::hl_tcl::my::data(SEEN,$txt),$tlen)}] set maxl [expr {min($::hl_tcl::my::data(SEEN,$txt),$tlen)}] for {set currQtd [set ln [set lnseen 0]]} {$ln<=$tlen} {} { set currQtd [HighlightLine $txt $ln $currQtd] incr ln if {[incr lnseen]>$::hl_tcl::my::data(SEEN,$txt)} { set lnseen 0 after idle after 1 [info coroutine] yield } } } } set ::hl_tcl::my::data(REG_TXT,$txt) {1} return }




CoroModified [::hl_tcl::my]my, Top

Handles modifications of text.

CoroModified txt ?i1? ?i2? ?args?
Parameters
txttext widget's path
i1Not documented; optional, default -1
i2Not documented; optional, default -1
argsOptional arguments.
See also

Modified


proc ::hl_tcl::my::CoroModified {txt {i1 -1} {i2 -1} args} { # Handles modifications of text. # txt - text widget's path # See also: Modified catch { variable data # current line: set ln [expr {int([$txt index insert])}] # ending line: set endl [expr {int([$txt index {end -1 char}])}] # range of change: if {$i1!=-1} { set dl [expr {abs($i2-$i1)}] set ln $i1 } else { set dl [expr {abs(int($data(CUR_LEN,$txt)) - $endl)}] } # begin and end of changes: set ln1 [set lno1 [expr {max(($ln-$dl),1)}]] set ln2 [set lno2 [expr {min(($ln+$dl),$endl)}]] lassign [CountQSH $txt $ln] cntq cnts ccmnt # flag "highlight to the end": set bf1 [expr {abs($ln-int($data(CURPOS,$txt)))>1 || $dl>1 || $cntq!=$data(CNT_QUOTE,$txt) || $ccmnt!=$data(CNT_COMMENT,$txt)}] set bf2 [expr {$cnts!=$data(CNT_SLASH,$txt)}] if {$bf1 && !$data(MULTILINE,$txt) || $bf2} { set lnt1 $ln set lnt2 [expr {$ln+1}] while {$ln2<$endl && $lnt1<$endl && $lnt2<=$endl && ( [$txt get "$lnt1.end -1 char" $lnt1.end] in {\\ \"} || [$txt get "$lnt2.end -1 char" $lnt2.end] in {\\ \"}) || $bf2} { incr lnt1 ;# next lines be handled too, if ended with "\\" incr lnt2 incr ln2 set bf2 0 } } set tSTR [$txt tag ranges tagSTR] set tCMN [$txt tag ranges tagCMN] if {$ln1==1} { set currQtd 0 } else { set currQtd [LineState $txt $tSTR $tCMN "$ln1.0 -1 chars"] } if {$data(PLAINTEXT,$txt)} { $txt tag add tagSTD $ln1.0 $ln2.end } else { set lnseen 0 while {$ln1<=$ln2} { if {$ln1==$ln2} { set bf2 [LineState $txt $tSTR $tCMN "$ln1.end +1 chars"] } RemoveTags $txt $ln1.0 $ln1.end set currQtd [HighlightLine $txt $ln1 $currQtd] if {$ln1==$ln2 && ($bf1 || $bf2!=$currQtd) && $data(MULTILINE,$txt)} { set ln2 $endl ;# run to the end } if {[incr lnseen]>$::hl_tcl::my::data(SEEN,$txt)} { set lnseen 0 catch {after cancel $data(COROATFER,$txt)} set data(COROATFER,$txt) [after idle after 1 [info coroutine]] yield } incr ln1 } } if {[set cmd $data(CMD,$txt)] ne {}} { # run a command after changes done (its arguments are txt, ln1, ln2) append cmd " $txt $lno1 $lno2 $args" {*}$cmd } MemPos $txt return } }




CoroRun [::hl_tcl::my]my, Top

CoroRun txt pos1 pos2 ?args?
Parameters
txtNot documented.
pos1Not documented.
pos2Not documented.
argsOptional arguments.

proc ::hl_tcl::my::CoroRun {txt pos1 pos2 args} { variable data if {![info exist data(REG_TXT,$txt)] || $data(REG_TXT,$txt) eq {} || ![info exist data(CUR_LEN,$txt)]} { # skip changes till the highlighting done after 10 [list ::hl_tcl::my::RunCoroAfterIdle $txt $pos1 $pos2 yes {*}$args] return } # let them work one by one set i1 [expr {int($pos1)}] set i2 [expr {int($pos2)}] set coroNo [expr {[incr ::hl_tcl::my::data(CORMOD)] % 10000000}] coroutine CoModified$coroNo ::hl_tcl::my::CoroModified $txt $i1 $i2 {*}$args }




CountChar [::hl_tcl::my]my, Top

Counts a character in a string.

CountChar str ch ?plistName? ?escaped?
Parameters
strthe string
chthe character
plistNamevariable name for a list of positions of ch; optional, default ""
escapedtrue, if the character is escaped; optional, default yes
Return value

Returns a number of any occurences of character ch in string str if the character is escaped, but if it is not escaped, only non-escaped characters are counted.


proc ::hl_tcl::my::CountChar {str ch {plistName {}} {escaped yes}} { # Counts a character in a string. # str - the string # ch - the character # plistName - variable name for a list of positions of *ch* # escaped - true, if the character is escaped. # Returns a number of any occurences of character *ch* in string *str* # if the character is escaped, but if it is not escaped, only non-escaped # characters are counted. if {$plistName ne {}} { upvar 1 $plistName plist set plist [list] } set icnt [set begidx 0] while {[set idx [string first $ch $str]] >= 0} { set nidx $idx if {$escaped || ![Escaped $str $idx]} { incr icnt if {$plistName ne {}} {lappend plist [expr {$begidx+$idx}]} } incr begidx [incr idx] set str [string range $str $idx end] } return $icnt }




CountQSH [::hl_tcl::my]my, Top

Counts quotes, slashes, hashes in a line

CountQSH txt ln
Parameters
txttext widget's path
lnline's index

proc ::hl_tcl::my::CountQSH {txt ln} { # Counts quotes, slashes, hashes in a line # txt - text widget's path # ln - line's index set ln [expr {int($ln)}] set st [$txt get $ln.0 $ln.end] return [list [CountChar $st \"] [CountChar $st \\] [CountChar $st #]] }




Escaped [::hl_tcl::my]my, Top

Checks if a character is escaped in a string.

Escaped line curpos
Parameters
linethe string
curposposition of the character in the line
Return value

Returns 1 if the character is escaped in the string.


proc ::hl_tcl::my::Escaped {line curpos} { # Checks if a character is escaped in a string. # line - the string # curpos - position of the character in the line # Returns 1 if the character is escaped in the string. set line [string range $line 0 $curpos-1] set linetrim [string trimright $line \\] return [expr {([string length $line]-[string length $linetrim])%2}] }




FirstQtd [::hl_tcl::my]my, Top

Searches the quote characters in line.

FirstQtd lineName iName currQtd
Parameters
lineNamevariable's name for 'line'
iNamevariable's name for 'i'
currQtdyes, if searching inside the quoted
Return value

Returns "yes" if a quote character was found.


proc ::hl_tcl::my::FirstQtd {lineName iName currQtd} { # Searches the quote characters in line. # lineName - variable's name for 'line' # iName - variable's name for 'i' # currQtd - yes, if searching inside the quoted # Returns "yes" if a quote character was found. variable data upvar 1 $lineName line $iName i while {1} { if {[set i [string first \" $line $i]]==-1} {return no} if {[NotEscaped $line $i]} { if {$currQtd} {return yes} set i1 [expr {$i-1}] set i2 [expr {$i+1}] if {[NotEscaped $line $i1]} { set c1 [string index $line $i1] ;# check the string ends set c2 [string index $line $i2] if {$c1 in $data(S_BOTH) || $c2 in $data(S_BOTH) || $c1 in $data(S_LEFT) && $c2 ni $data(S_RIGHT) || $c1 ni $data(S_LEFT) && $c2 in $data(S_RIGHT)} { return yes } # last reverence: for braced expression set i1 $i while {$i1>0} { set c1 [string index $line $i1-1] set c2 [string index $line $i1] if {$c1 in $data(S_SPACE)} {return [expr {$c2 ne "\{"}]} incr i1 -1 } return no } return yes } incr i } }




HighlightAll [::hl_tcl::my]my, Top

Highlights all of a text.

HighlightAll txt
Parameters
txttext widget's path
Description

Makes a coroutine from this.

See also

CoroHighlightAll


proc ::hl_tcl::my::HighlightAll {txt} { # Highlights all of a text. # txt - text widget's path # Makes a coroutine from this. # See also: CoroHighlightAll # let them work one by one: set coroNo [expr {[incr ::hl_tcl::my::data(CORALL)] % 10000000}] coroutine co_HlAll$coroNo ::hl_tcl::my::CoroHighlightAll $txt }




HighlightBrackets [::hl_tcl::my]my, Top

Highlights matching brackets if any.

HighlightBrackets w
Parameters
wtext widget's path

proc ::hl_tcl::my::HighlightBrackets {w} { # Highlights matching brackets if any. # w - text widget's path variable data set curpos [ShowCurrentLine $w] set curpos2 [$w index {insert -1 chars}] set ch [$w get $curpos] set il [string first $ch $data(LBR)] set ir [string first $ch $data(RBR)] set txt [split [$w get 1.0 end] \n] if {$il>-1} { set brcpos [MatchedBrackets $txt $curpos [string index $data(LBR) $il] [string index $data(RBR) $il] 1] } elseif {$ir>-1} { set brcpos [MatchedBrackets $txt $curpos [string index $data(RBR) $ir] [string index $data(LBR) $ir] -1] } elseif {[set il [string first [$w get $curpos2] $data(LBR)]]>-1} { set curpos $curpos2 set brcpos [MatchedBrackets $txt $curpos [string index $data(LBR) $il] [string index $data(RBR) $il] 1] } elseif {[set ir [string first [$w get $curpos2] $data(RBR)]]>-1} { set curpos $curpos2 set brcpos [MatchedBrackets $txt $curpos [string index $data(RBR) $ir] [string index $data(LBR) $ir] -1] } else { return } if {$brcpos ne {}} { $w tag add tagBRACKET $brcpos $w tag add tagBRACKET $curpos } else { $w tag add tagBRACKETERR $curpos } }




HighlightCmd [::hl_tcl::my]my, Top

Highlights Tcl/Tk commands.

HighlightCmd txt line ln pri i
Parameters
txttext widget's path
lineline to be highlighted
lnline number
pricolumn number to highlighted from
icurrent position in 'line'

proc ::hl_tcl::my::HighlightCmd {txt line ln pri i} { # Highlights Tcl/Tk commands. # txt - text widget's path # line - line to be highlighted # ln - line number # pri - column number to highlighted from # i - current position in 'line' variable data $txt tag add tagSTD "$ln.$pri" "$ln.$i +1 chars" if {$pri} { incr pri -1 set RE $data(RE1) } else { set RE $data(RE0) } set st [string range $line $pri $i-1] set lcom [regexp -inline -all -indices $RE $st] # commands foreach {- - lc -} $lcom { lassign $lc i1 i2 set c [string trim [string range $st $i1 $i2] "\{\}\[;\t "] set ik [expr {$i2-$i1+1-[string length $c]}] if {$c ne {}} { incr i1 $ik incr i2 if {[lsearch -exact -sorted $data(CMD_TCL) $c]>-1} { $txt tag add tagCOM "$ln.$pri +$i1 char" "$ln.$pri +$i2 char" } elseif {[lsearch -exact -sorted $data(PROC_TCL) $c]>-1} { $txt tag add tagPROC "$ln.$pri +$i1 char" "$ln.$pri +$i2 char" } elseif {[lsearch -exact -sorted $data(CMD_TK_EXP) $c]>-1} { $txt tag add tagCOMTK "$ln.$pri +$i1 char" "$ln.$pri +$i2 char" } } } # $variables: set dlist [list] set slen [expr {[string length $st]-1}] set cnt [CountChar $st \$ dlist no] foreach dl $dlist { if {[string index $st $dl+1] eq "\{"} { if {[set br2 [string first \} $st $dl+2]]!=-1} { $txt tag add tagVAR "$ln.$pri +$dl char" "$ln.$pri +[incr br2] char" } continue } for {set i [set dl2 $dl]} {$i<$slen} {} { incr i set ch [string index $st $i] if {[string is wordchar $ch] || $ch eq {:}} { set dl2 $i continue } elseif {$ch eq {(}} { if {[set br2 [string first {)} $st $i+1]]>-1} { set dl2 $br2 } } break } if {$dl2>$dl} { $txt tag add tagVAR "$ln.$pri +$dl char" "$ln.$pri +[incr dl2] char" } } # -options set dl -1 while {[set dl [string first - $st [incr dl]]]>-1} { if {[string index $st $dl-1] ni $data(S_SPACE2)} continue if {[string index $st $dl+1] eq {-}} { incr dl ;# for --longoption } set i $dl set ch [string index $st $i+1] if {![string is alpha -strict $ch]} { ;# || ![string is ascii -strict $ch] continue ;# first, a Latin letter } set dl2 -1 while {$i<$slen} { incr i set ch [string index $st $i] if {![string is wordchar $ch] && $ch ne {-}} break set dl2 $i } if {$dl2>-1} { $txt tag add tagOPT "$ln.$pri +$dl char" "$ln.$pri +[incr dl2] char" set dl $dl2 } } return }




HighlightLine [::hl_tcl::my]my, Top

Highlightes a line in text.

HighlightLine txt ln prevQtd
Parameters
txttext widget's path
lnline's number
prevQtdflag of "being quoted" from the previous line

proc ::hl_tcl::my::HighlightLine {txt ln prevQtd} { # Highlightes a line in text. # txt - text widget's path # ln - line's number # prevQtd - flag of "being quoted" from the previous line variable data set line [$txt get $ln.0 $ln.end] if {$prevQtd==-1} { ;# comments continued $txt tag add tagCMN $ln.0 $ln.end if {[string index $line end] ne "\\"} {set prevQtd 0} return $prevQtd } set currQtd $prevQtd ;# current state of being quoted set i [set pri [set lasti 0]] set k -1 while {1} { if {![FirstQtd line i $currQtd]} break set lasti $i if {$currQtd} { HighlightStr $txt $ln.$pri "$ln.$i +1 char" set currQtd 0 incr lasti if {[AuxEnding j line lasti]} { set i $lasti set st [string range $line $i $j] set it 0 if {[FirstQtd st it $currQtd]} continue ;# there is a quote yet set k $j break } } else { if {[AuxEnding j line pri] && $j<$i} { set lasti $pri set k $j break } HighlightCmd $txt $line $ln $pri $i set currQtd 1 } set pri $i incr i } if {$currQtd} { HighlightStr $txt $ln.$pri $ln.end } elseif {$k>-1 || [AuxEnding k line lasti]} { HighlightCmd $txt $line $ln $lasti $k $txt tag add tagCMN $ln.$k $ln.end if {[string index $line end] eq "\\"} {set currQtd -1} } else { HighlightCmd $txt $line $ln $lasti [string length $line] } if {!$data(MULTILINE,$txt) && $currQtd && [string index $line end] ne "\\"} { set currQtd 0 } return $currQtd }




HighlightStr [::hl_tcl::my]my, Top

Highlights strings.

HighlightStr txt p1 p2
Parameters
txttext widget's path
p1starting index of the string in 'txt'
p2ending index of the string in 'txt'

proc ::hl_tcl::my::HighlightStr {txt p1 p2} { # Highlights strings. # txt - text widget's path # p1 - starting index of the string in 'txt' # p2 - ending index of the string in 'txt' variable data set p1 [$txt index $p1] set p2 [$txt index $p2] $txt tag add tagSTR $p1 $p2 set st [$txt get $p1 $p2] set lcom [regexp -inline -all -indices $data(RE5) $st] foreach {lc g1 g2} $lcom { lassign $lc i1 i2 incr i2 while {$i1<$i2} { if {[string first [string index $st $i1] "\[\]\$\{\}"]>-1} { $txt tag add tagVAR "$p1 +$i1 char" "$p1 +$i2 char" } incr i1 } } return }




InRange [::hl_tcl::my]my, Top

Checks if a text position is in a range of text positions.

InRange p1 p2 l ?c?
Parameters
p11st position of range
p22nd position of range
lline position to check (or 'l.c' if 'c' not set)
ccolumn position to check; optional, default -1

proc ::hl_tcl::my::InRange {p1 p2 l {c -1}} { # Checks if a text position is in a range of text positions. # p1 - 1st position of range # p2 - 2nd position of range # l - line position to check (or 'l.c' if 'c' not set) # c - column position to check if {$c==-1} {lassign [split $l .] l c} lassign [split $p1 .] l1 c1 lassign [split $p2 .] l2 c2 incr c2 -1 ;# text ranges are not right-inclusive return [expr { ($l>=$l1 && $l<$l2 && $c>=$c1) || ($l>$l1 && $l<=$l2 && $c<=$c2) || ($l==$l1 && $l1==$l2 && $c>=$c1 && $c<=$c2) || ($l>$l1 && $l<$l2)}] }




LineState [::hl_tcl::my]my, Top

Gets an initial state of line.

LineState txt tSTR tCMN l1
Parameters
txttext widget's path
tSTRranges of string tags
tCMNranges of comment tags
l1the line's index
Description

Returns: 0 if no tags for the line; 1 if the line is a string's continuation; -1 if the line is a comment's continuation.


proc ::hl_tcl::my::LineState {txt tSTR tCMN l1} { # Gets an initial state of line. # txt - text widget's path # tSTR - ranges of string tags # tCMN - ranges of comment tags # l1 - the line's index # Returns: 0 if no tags for the line; 1 if the line is a string's continuation; -1 if the line is a comment's continuation. variable data set i1 [$txt index $l1] if {[set prev [string first -1 $l1]]>-1} { set i1 [$txt index "$i1 -1 chars"] } set ch [$txt get "$i1" "$i1 +1 chars"] if {[SearchTag $tCMN [$txt index "$i1 -1 chars"]]!=-1} { ;# is a comment continues? if {$ch eq "\\"} {return -1} } elseif {$data(MULTILINE,$txt) || $ch eq "\\"} { ;# is a string continues? set nl [lindex [split $l1 .] 0] if {$prev>-1} { # is the start of line quoted? # Tk tag ranges refer only to non-empty lines # => previous two non-empty chars' coordinates are needed # to analize whether they: # - end the range # - are inside of the range # - begin the range set co1 [set co2 {}] while {$nl>1} { incr nl -1 if {[set line [$txt get $nl.0 $nl.end]] ne {}} { if {$co2 eq {}} { set co2 [$txt index "$nl.end -1 char"] if {[string length $line]>1} { set co1 [$txt index "$nl.end -2 char"] break } } else { set co1 [$txt index "$nl.end -1 char"] break } } } if {$co2 eq {}} {return 0} {set f2 [expr {[SearchTag $tSTR $co2]!=-1}]} if {$co1 eq {}} {set f1 $f2} {set f1 [expr {[SearchTag $tSTR $co1]!=-1}]} set ch [$txt get $co2 "$co2 +1 chars"] set c [lindex [split [$txt index $co2] .] 1] if {![NotEscaped $line $c]} {set ch {}} return [expr {$ch ne {"} && $f2 || $ch eq {"} && !$f1}] } # is the end of line quoted? set line {} set nltot [lindex [split [$txt index end] .] 0] while {$nl<$nltot} { incr nl if {[set line [$txt get $nl.0 $nl.end]] ne {}} break } set i1 $nl.0 set ch [$txt get $i1 "$i1 +1 chars"] set c [lindex [split [$txt index $i1] .] 1] if {![NotEscaped $line $c]} {set ch {}} set f1 [expr {[SearchTag $tSTR [$txt index $i1]]!=-1}] set f2 [expr {[SearchTag $tSTR [$txt index "$i1 +1 chars"]]!=-1}] return [expr {$ch ne {"} && $f1 || $ch eq {"} && !$f2}] } return 0 }




MatchedBrackets [::hl_tcl::my]my, Top

Finds a match of characters (dchar for schar).

MatchedBrackets inplist curpos schar dchar dir
Parameters
inplistlist of strings where to find a match
curposposition of schar in nl.nc form where nl=1.., nc=0..
scharsource character
dchardestination character
dirsearch direction: 1 to the end, -1 to the beginning of list

proc ::hl_tcl::my::MatchedBrackets {inplist curpos schar dchar dir} { # Finds a match of characters (dchar for schar). # inplist - list of strings where to find a match # curpos - position of schar in nl.nc form where nl=1.., nc=0.. # schar - source character # dchar - destination character # dir - search direction: 1 to the end, -1 to the beginning of list lassign [split $curpos .] nl nc set escaped [Escaped [lindex $inplist $nl-1] $nc] if {$dir==1} {set rng1 "$nc end"} else {set rng1 "0 $nc"; set nc 0} set retpos {} set scount [set dcount 0] incr nl -1 set inplen [llength $inplist] while {$nl>=0 && $nl<$inplen} { set line [lindex $inplist $nl] set line [string range $line {*}$rng1] set sc [CountChar $line $schar slist $escaped] set dc [CountChar $line $dchar dlist $escaped] set plen [llength [set plist [MergePosList -1 $slist $dlist]]] for {set i [expr {$dir>0?0:($plen-1)}]} {$i>=0 && $i<$plen} {incr i $dir} { lassign [lindex $plist $i] src pos if {$src} {incr dcount} {incr scount} if {$scount <= $dcount} { set retpos [incr nl].[incr pos $nc] break } } if {$retpos ne {}} break set nc 0 set rng1 {0 end} incr nl $dir } return $retpos }




MemPos [::hl_tcl::my]my, Top

Remembers the state of current line.

MemPos txt ?doit?
Parameters
txttext widget's path
doitargument for ShowCurrentLine; optional, default no
See also

ShowCurrentLine


proc ::hl_tcl::my::MemPos {txt {doit no}} { # Remembers the state of current line. # txt - text widget's path # doit - argument for ShowCurrentLine # See also: ShowCurrentLine variable data set data(_INSPOS_,$txt) [MemPos1 $txt no] set ln [ShowCurrentLine $txt $doit] set data(CUR_LEN,$txt) [$txt index {end -1 char}] lassign [CountQSH $txt $ln] data(CNT_QUOTE,$txt) data(CNT_SLASH,$txt) data(CNT_COMMENT,$txt) if {[$txt tag ranges tagBRACKET] ne {}} {$txt tag remove tagBRACKET 1.0 end} if {[$txt tag ranges tagBRACKETERR] ne {}} {$txt tag remove tagBRACKETERR 1.0 end} if {[set cmd $data(CMDPOS,$txt)] ne {}} { # run a command after changing position (with the state as arguments) append cmd " $txt $data(CUR_LEN,$txt) $ln $data(CNT_QUOTE,$txt) $data(CNT_SLASH,$txt) $data(CNT_COMMENT,$txt)" catch {after cancel $data(CMDATFER,$txt)} set data(CMDATFER,$txt) [after idle $cmd] } }




MemPos1 [::hl_tcl::my]my, Top

Checks and sets the cursor's width, depending on its position.

MemPos1 txt ?donorm? ?K? ?s?
Parameters
txttext widget's path
donormif yes, forces "normal" cursor; optional, default yes
Kkey (%K of bind); optional, default ""
sstate (%s of bind); optional, default ""
Description

This fixes an issue with text cursor: less width at 0th column.


proc ::hl_tcl::my::MemPos1 {txt {donorm yes} {K {}} {s {}}} { # Checks and sets the cursor's width, depending on its position. # txt - text widget's path # donorm - if yes, forces "normal" cursor # K - key (%K of bind) # s - state (%s of bind) # This fixes an issue with text cursor: less width at 0th column. variable data if {$K eq {Home} && [string is digit -strict $s] && [expr {$s & 4}]==0 && [expr {$s & 1}]==0} { # Ctrl-Home & Shift-Home are passed set p1 [$txt index insert] set line [$txt get "$p1 linestart" "$p1 lineend"] set p [expr {[string length $line]-[string length [string trimleft $line]]}] set p2 [expr {int($p1)}].$p if {$p && $p2 ne $p1} { after idle "::tk::TextSetCursor $txt $p2" return } } if {$data(INSERTWIDTH,$txt)==1} { if {[$txt cget -insertwidth]!=1} {$txt configure -insertwidth 1} return 0 } set insLC [$txt index insert] lassign [split $insLC .] L C if {$data(_INSPOS_,$txt) eq {}} { set L2 [set C2 0] } else { lassign [split $data(_INSPOS_,$txt) .] L2 C2 } if {$L!=$L2 || $C==0 || $C2==0} { if {$C || $donorm} { $txt configure -insertwidth $data(INSERTWIDTH,$txt) } else { $txt configure -insertwidth [expr {$data(INSERTWIDTH,$txt)*2-1}] } } return $insLC }




MergePosList [::hl_tcl::my]my, Top

Merges lists of numbers that are not-coinciding and sorted.

MergePosList none ?args?
Parameters
nonea number to be not allowed in the lists (e.g. less than minimal)
argslist of the lists to be merged
Return value

Returns a list of pairs: index of list + item of list.


proc ::hl_tcl::my::MergePosList {none args} { # Merges lists of numbers that are not-coinciding and sorted. # none - a number to be not allowed in the lists (e.g. less than minimal) # args - list of the lists to be merged # Returns a list of pairs: index of list + item of list. set itot [set ilist 0] set lind [set lout [list]] foreach lst $args { incr ilist incr itot [set llen [llength $lst]] lappend lind [list 0 $llen] } for {set i 0} {$i<$itot} {incr i} { set min $none set ind -1 for {set k 0} {$k<$ilist} {incr k} { lassign [lindex $lind $k] li llen if {$li < $llen} { set e [lindex [lindex $args $k] $li] if {$min == $none || $min > $e} { set ind $k set min $e set savli [incr li] set savlen $llen } } } if {$ind == -1} {return -code error {Error: probably in the input data}} lset lind $ind [list $savli $savlen] lappend lout [list $ind $min] } return $lout }




Modified [::hl_tcl::my]my, Top

Handles modifications of text.

Modified txt oper pos1 ?args?
Parameters
txttext widget's path
operNot documented.
pos1Not documented.
argsOptional arguments.
Description

Makes a coroutine from this.

See also

CoroModified


proc ::hl_tcl::my::Modified {txt oper pos1 args} { # Handles modifications of text. # txt - text widget's path # Makes a coroutine from this. # See also: CoroModified variable data set ar2 [lindex $args 0] set posins [$txt index insert] if {[catch {set pos1 [set pos2 [$txt index $pos1]]}]} { set pos1 [set pos2 $posins] } switch $oper { insert { set pos2 [expr {$pos1 + [llength [split $ar2 \n]]}] } delete { if {$ar2 eq {} || [catch {set pos2 [$txt index $ar2]}]} { set pos2 $posins } } } RunCoroAfterIdle $txt $pos1 $pos2 no {*}$args }




NotEscaped [::hl_tcl::my]my, Top

Checks if a character escaped in a line.

NotEscaped line i
Parameters
lineline
ithe character's position in 'line'
Return value

Returns "1" if the character not escaped.


proc ::hl_tcl::my::NotEscaped {line i} { # Checks if a character escaped in a line. # line - line # i - the character's position in 'line' # Returns "1" if the character not escaped. set cntq 0 while {$i>0} { if {[string index $line [incr i -1]] ne "\\"} { return [expr {($cntq%2)==0}] } incr cntq } return [expr {($cntq%2)==0}] }




RemoveTags [::hl_tcl::my]my, Top

Removes tags in text.

RemoveTags txt from to
Parameters
txttext widget's path
fromstarting index
toending index

proc ::hl_tcl::my::RemoveTags {txt from to} { # Removes tags in text. # txt - text widget's path # from - starting index # to - ending index foreach tag {tagCOM tagCOMTK tagSTR tagVAR tagCMN tagPROC tagOPT} { $txt tag remove $tag $from $to } return }




RunCoroAfterIdle [::hl_tcl::my]my, Top

Runs a "modified" corotine after idle.

RunCoroAfterIdle txt pos1 pos2 wait ?args?
Parameters
txtNot documented.
pos1Not documented.
pos2Not documented.
waitNot documented.
argsOptional arguments.

proc ::hl_tcl::my::RunCoroAfterIdle {txt pos1 pos2 wait args} { # Runs a "modified" corotine after idle. variable data if {$wait} { catch { after cancel $data(COROAFTER,$txt) if {$data(COROPOS1,$txt) < $pos1} {set pos1 $data(COROPOS1,$txt)} if {$data(COROPOS2,$txt) > $pos2} {set pos2 $data(COROPOS2,$txt)} } set data(COROPOS1,$txt) $pos1 set data(COROPOS2,$txt) $pos2 } set data(COROAFTER,$txt) [after idle "::hl_tcl::my::CoroRun $txt $pos1 $pos2 $args"] }




SearchTag [::hl_tcl::my]my, Top

Searches a position in tag ranges.

SearchTag tagpos l1
Parameters
tagpostag position ranges
l1the position to find
Return value

Returns a found range's index of -1 if not found.


proc ::hl_tcl::my::SearchTag {tagpos l1} { # Searches a position in tag ranges. # tagpos - tag position ranges # l1 - the position to find # Returns a found range's index of -1 if not found. lassign [split $l1 .] l c set i 0 foreach {p1 p2} $tagpos { if {[InRange $p1 $p2 $l $c]} {return $i} incr i 2 } return -1 }




ShowCurrentLine [::hl_tcl::my]my, Top

Shows the current line.

ShowCurrentLine txt ?doit?
Parameters
txttext widget's path
doitif yes, forces updating current line's background; optional, default no
Return value

Returns a current position of cursor.


proc ::hl_tcl::my::ShowCurrentLine {txt {doit no}} { # Shows the current line. # txt - text widget's path # doit - if yes, forces updating current line's background # Returns a current position of cursor. variable data set pos [$txt index insert] set nlines [expr {int([$txt index end])}] lassign [split $pos .] ln cn if {[catch {lassign [split $data(CURPOS,$txt) .] ln2 cn2}]} { set ln2 $ln set cn2 $cn set data(CURPOS,$txt) [set data(NLINES,$txt) 0] } if {$doit || int($data(CURPOS,$txt))!=$ln || $data(NLINES,$txt)!=$nlines || $ln!=$ln2 || abs($cn-$cn2)>1 || $cn<2} { $txt tag remove tagCURLINE 1.0 end $txt tag add tagCURLINE [list $pos linestart] [list $pos lineend]+1displayindices } set data(NLINES,$txt) $nlines set data(CURPOS,$txt) $pos return $pos }

Document generated by Ruff!