README.md

hl_tcl

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-blah

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 editors

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 {{#000} #FFF} is quite a legal Tcl command as well as set c {#000 #FFF}, not for Geany

no highlighting TclOO (method, my, mixin 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?

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

allowing additional commands to highlight (as Tk ones)

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 widget

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")

-keywords - additional commands to highlight (as Tk ones)

-dobind - if true, forces keys binding at repeating calls of hl_init

-plaintext - true for plain texts with no highlighting

-plaincom - a command for plain highlighting line by line

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.

A command for -plaincom option has two arguments: a current text's path and a current line's number. It should highlight the current line and return true, otherwise (if the current line is Tcl code) it returns false. An example of its usage is presented by alited editor (lib/addon directory).

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 html

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>}

Links

Reference

Source (hl_tcl.zip)

Demo of hl_tcl v0.6.1 (25 Mb)

Note that hl_tcl is still disposed to update.

hl_c.tcl

###########################################################
# Name:    hl_c.tcl
# Author:  Alex Plotnikov  (aplsimple@gmail.com)
# Date:    06/16/2021
# Brief:   Handles highlighting C code.
# License: MIT.
###########################################################

# ______________________ Common data ____________________ #

namespace eval ::hl_c {

  namespace eval my {

    variable data;  array set data [list]

    # C reserved words
    set data(PROC_C) [lsort [list goto return]]
    set data(CMD_C1) [list \
    auto break case char const continue default do double else enum extern \
    float for if inline int long register restrict short signed sizeof \
    static struct switch typedef union unsigned void volatile while \
    ]
    # other C token
    set data(CMD_C2) [list \
    ifdef endif \
    ]
    set data(CMD_C) [lsort [concat $data(CMD_C1) $data(CMD_C2)]]

    # C++ reserved words
    set data(CMD_CPP1) [list \
    and and_eq asm bitand bitor bool catch class compl const_cast delete \
    dynamic_cast explicit false friend inline  mutable namespace new \
    not not_eq operator or or_eq private public protected \
    reinterpret_cast static_cast template this throw true try typeid \
    typename using virtual wchar_t xor xor_eq \
    ]

    # C++ predefined identifiers
    set data(CMD_CPP2) [list \
    cin cout endl include INT_MAX INT_MIN iomanip iostream main MAX_RAND \
    npos NULL std string FALSE TRUE \
    ]

    # C++ united
    set data(CMD_CPP) [lsort [concat $data(CMD_CPP1) $data(CMD_CPP2)]]

    # regexp for key words and punctuation
    set data(RE0) {\w+}
    set data(RE1) {[<>(){};=!%&^*+-.,\|:/\\#]+}

    # characters of multiline comment, string and char and their counterparts
    set data(PAIR1) [list /* \" ' //]
    set data(PAIR2) [list */ \" ']
    set data(PAIR_COMMENT) 0  ;# indices for multiline comment/ string/ char
    set data(PAIR_STRING) 1
    set data(PAIR_CHAR) 2
    set data(PAIR_COMMENT1) 3
  }
}

# _________________________ STATIC highlighting _________________________ #

proc ::hl_c::my::HighlightCmd {txt line ln pri i} {
  # Highlights C 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"
  set st [string range $line $pri $i]
  set lcom [regexp -inline -all -indices $data(RE0) $st]
  foreach lc $lcom {
    lassign $lc i1 i2
    set word [string range $st $i1 $i2]
    if {$word in $data(CMD_C)} {
      $txt tag add tagCOM "$ln.$pri +$i1 char" "$ln.$pri +[incr i2] char"
    } elseif {$word in $data(PROC_C)} {
      $txt tag add tagPROC "$ln.$pri +$i1 char" "$ln.$pri +[incr i2] char"
    } elseif {$word in $data(CMD_CPP)} {
      $txt tag add tagCOMTK "$ln.$pri +$i1 char" "$ln.$pri +[incr i2] char"
    } elseif {$word in $data(KEYWORDS,$txt)} {
      $txt tag add tagOPT "$ln.$pri +$i1 char" "$ln.$pri +[incr i2] char"
    }
  }
  set lcom [regexp -inline -all -indices $data(RE1) $st]
  foreach lc $lcom {
    lassign $lc i1 i2
    $txt tag add tagVAR "$ln.$pri +$i1 char" "$ln.$pri +[incr i2] char"
  }
}
#_______________________

proc ::hl_c::my::HighlightLine {txt ln currQtd} {
  # Highlightes a line in text.
  #   txt - text widget's path
  #   ln - line's number
  #   currQtd - 0, 1 or 2 referring to comment/string/char
  # Returns currQtd for the end of the line.

  variable data
  set line [$txt get $ln.0 $ln.end]
  set i1 [set i0 0]
  set i2 [set llen [string length $line]]
  while {$i1<$llen} {
    if {$currQtd>-1} {
      # if quoted then there follows a multiline comment or a string/char
      # => find its pair
      if {$currQtd==$data(PAIR_COMMENT)} {
        set tag tagCMN  ;# comment
      } else {
        set tag tagSTR  ;# string/char
      }
      set ch [lindex $data(PAIR2) $currQtd]
      set i2 [string first $ch $line $i1]
      while {$i2!=-1} {
        if {[::hl_tcl::my::NotEscaped $line $i2]} break
        set i2 [string first $ch $line $i2+1]
      }
      if {$i2==-1} {
        # a pair not found - the comment/string/char is not ended
        if {$currQtd!=$data(PAIR_COMMENT) && \
        ($currQtd==$data(PAIR_CHAR) || [string index $line end] ne "\\")} {
          set currQtd -1  ;# char or string not ended properly
        }
        $txt tag add $tag $ln.$i0 $ln.end
        return $currQtd
      }
      # the pair found - highlight an appropriate part of the line
      set lp [string length [lindex $data(PAIR2) $currQtd]]
      $txt tag add $tag $ln.[incr i1 -$lp] $ln.[incr i2 $lp]
      set i1 $i2
      set currQtd -1
      continue
    }
    # not quoted - find a nearest "quote" (comment/string/char)
    set i0 $llen
    set i 0
    foreach par $data(PAIR1) {
      if {[set p [string first $par $line $i1]]>-1 && $p<$i0 && [::hl_tcl::my::NotEscaped $line $p]} {
        set i0 $p
        set ip $i
      }
      incr i
    }
    if {$i0<$llen} {
      HighlightCmd $txt $line $ln $i1 [expr {$i0-1}]
      # a comment/string/char was found
      if {$ip==$data(PAIR_COMMENT1)} {
        if {[regexp -start $i0 {\s*//\s*(!|TODO)} $line]} {
          $txt tag add tagCMN2 $ln.$i0 $ln.end
        } else {
          $txt tag add tagCMN1 $ln.$i0 $ln.end
        }
        return -1  ;# it was a one-line comment
      }
      set currQtd $ip
      set lp [string length [lindex $data(PAIR2) $currQtd]]
      set i1 [expr {$i0+$lp}]
      if {$i1>=($llen-1)} {
        if {$currQtd==$data(PAIR_COMMENT)} {
          set tag tagCMN  ;# comment
        } else {
          set tag tagSTR  ;# string/char
        }
        $txt tag add $tag $ln.$i0 $ln.end
      }
      continue
    }
    HighlightCmd $txt $line $ln $i1 [expr {$llen-1}]
    set currQtd -1
    break
  }
  return $currQtd
}
#_______________________

proc ::hl_c::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_c::my::data(CORALL)] % 10000000}]
  coroutine co_HlAll$coroNo ::hl_c::my::CoroHighlightAll $txt
}
#_______________________

proc ::hl_c::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_c::my::data(SEEN,$txt),$tlen)}]
      set maxl [expr {min($::hl_c::my::data(SEEN,$txt),$tlen)}]
      set currQtd -1
      for {set ln [set lnseen 0]} {$ln<=$tlen} {} {
        set currQtd [HighlightLine $txt $ln $currQtd]
        incr ln
        if {[incr lnseen]>$::hl_c::my::data(SEEN,$txt)} {
          set lnseen 0
          after idle after 1 [info coroutine]
          yield
        }
      }
    }
  }
  set ::hl_c::my::data(REG_TXT,$txt) {1}
  return
}

# _________________________ DYNAMIC highlighting ________________________ #

proc ::hl_c::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 tagCMN1 tagCMN2 tagPROC tagOPT} {
    $txt tag remove $tag $from $to
  }
}
#_______________________

proc ::hl_c::my::CountQSH {txt ln} {
  # Counts quotes, slashes, comments 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]
  set quotes 0
  foreach spch {"\"" '} {
    incr quotes [::hl_tcl::my::CountChar $st $spch]
  }
  set slashes [::hl_tcl::my::CountChar $st "\\"]
  set comments 0
  foreach spch {/ *} {
    incr comments [::hl_tcl::my::CountChar $st $spch]
  }
  list $quotes $slashes $comments
}
#_______________________

proc ::hl_c::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
}

proc ::hl_c::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(CURPOS,$txt) $ln
  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]
  }
}
#_______________________

proc ::hl_c::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
      }
    }
  }
  after idle "::hl_c::my::CoroRun $txt $pos1 $pos2 $args"
}
#_______________________

proc ::hl_c::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)]} {
    return  ;# skip changes till the highlighting done
  }
  # let them work one by one
  set i1 [expr {int($pos1)}]
  set i2 [expr {int($pos2)}]
  set coroNo [expr {[incr ::hl_c::my::data(CORMOD)] % 10000000}]
  coroutine CoModified$coroNo ::hl_c::my::CoroModified $txt $i1 $i2 {*}$args
}
#_______________________

proc ::hl_c::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 -1
    } else {
      set currQtd [LineState $txt $tSTR $tCMN "$ln1.0 -1 chars"]
    }
    if {!$data(PLAINTEXT,$txt)} {
      set lnseen 0
      $txt tag add tagSTD $ln1.0 $ln2.end
      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_c::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"
      after idle $cmd
    }
    MemPos $txt
    return
  }
}
#_______________________

proc ::hl_c::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: a flag of 'quoted' line or -1.

  set i1 [$txt index $l1]
  if {[set prev [string first -1 $l1]]>-1} {
    set i1 [$txt index "$i1 -1 chars"]
  }
  if {[::hl_tcl::my::SearchTag $tCMN [$txt index "$i1 -1 chars"]]!=-1} {
    if {[$txt get "$i1 -1 chars" "$i1 +1 chars"] eq {*/}} {
      return -1
    }
    return 0
  }
  set ch [$txt get "$i1" "$i1 +1 chars"]
  if {[::hl_tcl::my::SearchTag $tSTR [$txt index "$i1 -1 chars"]]!=-1} {
    if {$ch eq "\\"} {return 1}
  }
  return -1
}
#_______________________

proc ::hl_c::my::ShowCurrentLine {txt {doit no}} {
  # Shows the current line.
  #   txt - text widget's path
  #   doit - if yes, forces updating current line's background

  variable data
  set pos [$txt index insert]
  lassign [split $pos .] ln cn
  if {[::hl_tcl::my::IsCurline $txt]} {
    if {$doit || ![info exists data(CURPOS,$txt)] || int($data(CURPOS,$txt))!=$ln || $cn<2} {
      $txt tag remove tagCURLINE 1.0 end
      $txt tag add tagCURLINE [list $pos linestart] [list $pos lineend]+1displayindices
    }
  }
  return $pos
}

# _________________________ INTERFACE procedures ________________________ #

proc ::hl_c::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_c::my::data(READONLY,$txt)] && $::hl_c::my::data(READONLY,$txt)}]
  }
  set ::hl_c::my::data(READONLY,$txt) $ro
  if {$com2 ne {}} {set ::hl_c::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} "
    if {!\[winfo exists $txt\]} {return 0}
    switch -exact -- \[lindex \$args 0\] \{
      insert \{$com2\}
      delete \{$com2\}
      replace \{$com2\}
      default \{ return \[eval $newcom \$args\] \}
    \}"
  } else {proc ::$txt {args} "
    if {!\[winfo exists $txt\]} {return 0}
    switch -exact -- \[lindex \$args 0\] \{
      delete \{$com {*}\$args\}
      insert \{$com {*}\$args\}
      replace \{$com {*}\$args\}
    \}
    set _res_ \[eval $newcom \$args\]
    return \$_res_"
  }
}
#_______________________

proc ::hl_c::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
  # 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]
  }
  ::hl_tcl::iscurline $txt 1
  set ::hl_c::my::data(REG_TXT,$txt) {}  ;# disables Modified at changing the text
  set ::hl_c::my::data(KEYWORDS,$txt) {}
  # get default options from text's ones
  set defopts [list -insertwidth]
  foreach defopt $defopts {
    set opt [::hl_tcl::OptName $txt $defopt]
    if {![info exists ::hl_c::my::data($opt)]} {
      set ::hl_c::my::data($opt,DEFAULT) [$txt cget $defopt]
    }
  }
  foreach {opt val} {-dark 0 -readonly 0 -cmd {} -cmdpos {} -optRE 1 \
  -multiline 1 -seen 500 -plaintext no -insertwidth {} -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_c::my::data([::hl_tcl::OptName $txt $opt]) $val
  }
  # reget default options from text's ones
  foreach defopt $defopts {
    set opt [::hl_tcl::OptName $txt $defopt]
    if {[info exists ::hl_c::my::data($opt)] && $::hl_c::my::data($opt) eq {}} {
      set ::hl_c::my::data($opt) $::hl_c::my::data($opt,DEFAULT)
    }
  }
  set ::hl_c::my::data(KEYWORDS,$txt) [lsort $::hl_c::my::data(KEYWORDS,$txt)]
  if {[dict exists $args -colors]} {
    set ::hl_c::my::data(COLORS,$txt) [dict get $args -colors]
    set ::hl_c::my::data(SETCOLORS,$txt) 1
  } else {
    if {![info exists ::hl_c::my::data(COLORS,$txt)]}  {
      set clrCURL {}
      catch {set clrCURL [lindex [::apave::obj csGet] 16]}
      if {$::hl_c::my::data(DARK,$txt)} {
        if {$clrCURL eq {}} {set clrCURL #29383c}
        set ::hl_c::my::data(COLORS,$txt) [list {*}[hl_colors $txt] $clrCURL]
      } else {
        if {$clrCURL eq {}} {set clrCURL #efe0cd}
        set ::hl_c::my::data(COLORS,$txt) [list {*}[hl_colors $txt] $clrCURL]
      }
    }
  }
  if {!$setonly} {
    if {[dict exists $args -font]} {
      set ::hl_c::my::data(FONT,$txt) [dict get $args -font]
    } else {
      set ::hl_c::my::data(FONT,$txt) [font actual TkFixedFont]
    }
  }
  if {!$setonly || [dict exists $args -readonly]} {
    hl_readonly $txt $::hl_c::my::data(READONLY,$txt)
  }
  if {[string first ::hl_c:: [bind $txt]]<0} {
    ::hl_tcl::my::BindToEvent $txt <FocusIn> ::hl_c::my::ShowCurrentLine $txt
  }
  set ::hl_c::my::data(_INSPOS_,$txt) {}
  my::MemPos $txt
}
#_______________________

proc ::hl_c::hl_text {txt} {
  # Highlights C code of a text widget.
  #   txt - text widget's path

  set font0 $::hl_c::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_c::my::data(COLORS,$txt) \
    clrCOM clrCOMTK clrSTR clrVAR clrCMN clrPROC clrOPT clrBRA clrCURL clrCMN2
  $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 tagCMN1 -font "$font2" -foreground $clrCMN
  $txt tag configure tagCMN2 -font "$font2" -foreground $clrCMN2 ;#red
  $txt tag configure tagPROC -font "$font1" -foreground $clrPROC
  $txt tag configure tagOPT -font "$font1" -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
  ::hl_tcl::my::BindToEvent $txt <FocusIn> ::hl_c::my::MemPos $txt
  ::hl_tcl::my::BindToEvent $txt <KeyPress> ::hl_c::my::MemPos1 $txt yes %K %s
  ::hl_tcl::my::BindToEvent $txt <KeyRelease> ::hl_c::my::MemPos $txt
  ::hl_tcl::my::BindToEvent $txt <ButtonRelease-1> ::hl_c::my::MemPos $txt
  foreach ev {Enter KeyRelease ButtonRelease-1} {
    ::hl_tcl::my::BindToEvent $txt <$ev> ::hl_tcl::my::HighlightBrackets $txt
  }
  set ro $::hl_c::my::data(READONLY,$txt)
  set com2 $::hl_c::my::data(CMD,$txt)
  set txtattrs [list $txt $ro $com2]
  if {![info exists ::hl_c::my::data(LIST_TXT)] || \
  [set i [lsearch -index 0 -exact $::hl_c::my::data(LIST_TXT) $txt]]==-1} {
    lappend ::hl_c::my::data(LIST_TXT) $txtattrs
  } else {
    set ::hl_c::my::data(LIST_TXT) [lreplace $::hl_c::my::data(LIST_TXT) $i $i $txtattrs]
  }
  hl_readonly $txt $ro $com2
}
#_______________________

proc ::hl_c::hl_all {args} {
  # Updates ("rehighlights") all highlighted and existing text widgets.
  #   args - dict of options
  # See also: hl_init

  if {[info exists ::hl_c::my::data(LIST_TXT)]} {
    foreach wattrs $::hl_c::my::data(LIST_TXT) {
      lassign $wattrs txt ro com2
      if {[winfo exists $txt]} {
        if {![info exists ::hl_c::my::data(SETCOLORS,$txt)]} {
          unset ::hl_c::my::data(COLORS,$txt) ;# colors defined by DARK
        }
        # args (if set) override the appropriate settings for $txt
        hl_init $txt -- {*}$args
        hl_text $txt
      }
    }
  }
}
#_______________________

proc ::hl_c::hl_colors {txt {dark ""}} {
  # Gets the main colors for highlighting (except for "curr.line").
  #   txt - text widget's path or {} or an index of default colors
  #   dark - flag "dark scheme"
  # Returns a list of colors for COM COMTK STR VAR CMN PROC OPT BRAC \
   or, if the colors aren't initialized, "standard" colors.

  if {[info exists ::hl_c::my::data(COLORS,$txt)]}  {
    return $::hl_c::my::data(COLORS,$txt)
  }
  if {$dark eq {}} {set dark $::hl_c::my::data(DARK,$txt)}
  if {![string is integer -strict $txt] || $txt<0 || $txt>3} {set txt 0}
  if {$dark} {set dark 1} {set dark 0}
  set res [lindex $::hl_tcl::my::data(SYNTAXCOLORS,$txt) $dark]
  # user keywords' color
  set res [lreplace $res 6 6 [lindex $res 1]]
  return $res
}
#_______________________

proc ::hl_c::hl_line {txt} {
  # Updates a current line's highlighting.
  #   txt - text's path

  if {!$::hl_c::my::data(PLAINTEXT,$txt)} {
    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
    after idle "::hl_c::my::CoroRun $txt $ln1 $ln2"
  }
  ::hl_c::my::MemPos $txt yes
  $txt configure -insertwidth $::hl_c::my::data(INSERTWIDTH,$txt)
}
#_______________________

proc ::hl_c::isdone {txt} {
  # Checks if the highlighting of the text is done.
  #   txt - text's path

  variable my::data
  return [expr {[info exist my::data(REG_TXT,$txt)] && $my::data(REG_TXT,$txt) ne {}}]
}
#_______________________

proc ::hl_c::clearup {txt} {
  # Clears data related to text (esp. at deleting it).
  #   txt - text's path

  variable my::data
  foreach key [array names my::data *,$txt] {
    unset my::data($key)
  }
  foreach i [lsearch -all -exact -index 0 $my::data(LIST_TXT) $txt] {
    set my::data(LIST_TXT) [lreplace $my::data(LIST_TXT) $i $i]
  }
}
#_______________________

proc ::hl_c::cget {txt opt} {
  # Gets a highlighting option's value.
  #   txt - text's path
  #   opt - option's name

  variable my::data
  set opt [string toupper [string trimleft $opt -]]
  if {[info exists my::data($opt,$txt)]} {
    return $my::data($opt,$txt)
  }
  return {}
}
#_______________________

proc ::hl_c::configure {txt opt val} {
  # Sets a highlighting option's value.
  #   txt - text's path
  #   opt - option's name
  #   val - option's value

  variable my::data
  set opt [string toupper [string trimleft $opt -]]
  set my::data($opt,$txt) $val
}

# _________________________________ EOF _________________________________ #

hl_c.tcl