TkScintilla

TkScintilla: Scintilla Tcl/Tk Binding

Demo

https://web.archive.org/web/20210524194956/archive.tcltk.co.kr/tkscintilla/tkscintilla.png

load tkscintilla.dll

set frame [frame .frame]
pack $frame -side top -fill both -expand true -padx 2 -pady 2

set button [ttk::button $frame.button \
        -text "Scintilla Demo"]
pack $button -pady 5

set statusbar [ttk::label $frame.statusbar -text ""]
pack $statusbar -side bottom -fill x

        # --------------------
        set eventframe [TkScintillaEventFrame $frame.eventframe]
        pack $eventframe -side top -fill both -expand true

        set text [TkScintilla $eventframe.text \
                -width 600 -height 550 \
                -marginclickedcommand { MarginClicked }\
                -charaddedcommand { CharAdded }\
                -styleneededcommand { StyleNeeded }\
                -keycommand { Key }]
        pack $text -fill both -expand true

        bind $text <<UpdateUI>> { UpdateUI %W }

        $button configure -command [list Save $text]

proc Key {w key modifiers} {
        set handle [$w GetHandle]
        set pos [SendMessage $handle $::SCI_GETCURRENTPOS 0 0]

        if { [expr ${modifiers} & ${::SCMOD_CTRL}] } {
                puts "Key: CTRL+$key"
        } elseif { [expr ${modifiers} & ${::SCMOD_ALT}] } {
                puts "Key: ALT+$key"
        } elseif { [expr ${modifiers} & ${::SCMOD_SHIFT}] } {
                puts "Key: SHIFT+$key"
        } else {
                if { $key == 112 } { ; # F1
                }
        }
}

proc CharAdded {w key} {
    puts "CharAdded: $key"
}

proc StyleNeeded {w pos} {
    puts "StyleNeeded: $pos"
}

proc Save {w} {
    puts [GetText $w]
}

proc GetText {w} {
        set handle [$w GetHandle]
        set len [SendMessage $handle $::SCI_GETTEXTLENGTH 0 0]
    return [GetTextRange $w 0 $len]
}

proc GetTextRange {w startPos endPos} {
        set handle [$w GetHandle]
    return [tksci_GetTextRange $handle $startPos $endPos]
}

proc StyleSetSpec {handle styleNum fg bg face size bold italic underline} {
        SendMessage $handle $::SCI_STYLESETFORE $styleNum [rgb_to_long $fg]
        SendMessage $handle $::SCI_STYLESETBACK $styleNum [rgb_to_long $bg]
        SendMessage $handle $::SCI_STYLESETFONT $styleNum [charp_to_long $face]
        SendMessage $handle $::SCI_STYLESETSIZE $styleNum $size
        SendMessage $handle $::SCI_STYLESETBOLD $styleNum $bold
        SendMessage $handle $::SCI_STYLESETITALIC $styleNum $italic
        SendMessage $handle $::SCI_STYLESETUNDERLINE $styleNum $underline
}

proc SetDefaultStyle {handle} {
        SendMessage $handle $::SCI_SETCARETLINEVISIBLE 1 0

        SendMessage $handle $::SCI_SETCARETFORE [rgb_to_long "#000000"] 0
        SendMessage $handle $::SCI_SETCARETLINEBACK [rgb_to_long "#f0f0f0"] 0

        SendMessage $handle $::SCI_SETSELFORE 1 [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_SETSELBACK 1 [rgb_to_long "#506D99"]

        SendMessage $handle $::SCI_SETEDGECOLOUR [rgb_to_long "#C0C0C0"] 0

        StyleSetSpec $handle $::SCE_TCL_DEFAULT "#000000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_IDENTIFIER "#000000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_WORD "#0000FF" "#FFFFFF" "Courier New" 9 1 0 0
        StyleSetSpec $handle $::SCE_TCL_COMMENT "#008000" "#FFFFFF" "Courier New" 9 0 1 0
        StyleSetSpec $handle $::SCE_TCL_COMMENTLINE "#008000" "#FFFFFF" "Courier New" 9 0 1 0
        StyleSetSpec $handle $::SCE_TCL_COMMENT_BOX "#008000" "#FFFFFF" "Courier New" 9 0 1 0
        StyleSetSpec $handle $::SCE_TCL_NUMBER "#FF0000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_OPERATOR "#000000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_SUBSTITUTION "#000000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_SUB_BRACE "#000000" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_MODIFIER "#0000FF" "#FFFFFF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::SCE_TCL_IN_QUOTE "#FF0000" "#FFFFFF" "Courier New" 9 0 0 0

        SendMessage $handle $::SCI_SETFOLDMARGINCOLOUR 1 [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_SETFOLDMARGINHICOLOUR 1 [rgb_to_long "#FFFFFF"]
        
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDEROPEN [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDEROPEN [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDER [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDER [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDERSUB [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDERSUB [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDERTAIL [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDERTAIL [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDEREND [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDEREND [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDEROPENMID [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDEROPENMID [rgb_to_long "#E9E8DF"]
        SendMessage $handle $::SCI_MARKERSETFORE $::SC_MARKNUM_FOLDERMIDTAIL [rgb_to_long "#FFFFFF"]
        SendMessage $handle $::SCI_MARKERSETBACK $::SC_MARKNUM_FOLDERMIDTAIL [rgb_to_long "#E9E8DF"]
        
        StyleSetSpec $handle $::STYLE_LINENUMBER "#C0C0C0" "#E9E8DF" "Courier New" 9 0 0 0
        StyleSetSpec $handle $::STYLE_BRACELIGHT "#000000" "#f0f0f0" "Courier New" 9 1 0 0
        StyleSetSpec $handle $::STYLE_BRACEBAD "#FF0000" "#f0f0f0" "Courier New" 9 1 0 0

        SendMessage $handle $::SCI_SETWORDCHARS \
                [charp_to_long "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_-:$"] 0
        SendMessage $handle $::SCI_SETKEYWORDS \
                0 [charp_to_long [info commands]]
}

proc MarginClicked {w margin position} {
        set handle [$w GetHandle]
        set line [SendMessage $handle $::SCI_LINEFROMPOSITION $position 0]
        SendMessage $handle $::SCI_TOGGLEFOLD $line 0
}

proc HighlightBrace {w} {
    set handle [$w GetHandle]
        
    set currPos [SendMessage $handle $::SCI_GETCURRENTPOS 0 0]
    set newPos [SendMessage $handle $::SCI_BRACEMATCH $currPos 0]
    if { $newPos == -1 } {
        if { $currPos > 0 } {
            set currPos [expr $currPos-1]
        }
        set newPos [SendMessage $handle $::SCI_BRACEMATCH $currPos 0]
    }
    set ch [long_to_ascii [SendMessage $handle $::SCI_GETCHARAT $currPos 0]]
    if { $ch == "\{" || $ch == "\[" || $ch == "(" || \
        $ch == "\}" || $ch == "\]" || $ch == ")" } {
        if { $newPos != -1 } {
            SendMessage $handle $::SCI_BRACEHIGHLIGHT $currPos $newPos
        } else {
            SendMessage $handle $::SCI_BRACEBADLIGHT $currPos 0
        }
    } else {
        SendMessage $handle $::SCI_BRACEHIGHLIGHT -1 -1
    }
}

proc UpdateUI {w} {
        set handle [$w GetHandle]
        set pos [SendMessage $handle $::SCI_GETCURRENTPOS 0 0]
        set line [expr [SendMessage $handle $::SCI_LINEFROMPOSITION $pos 0] +1]
        set col [expr [SendMessage $handle $::SCI_GETCOLUMN $pos 0] +1]
        $::statusbar configure -text "Line: $line, Col: $col, Pos: $pos"

        set value [SendMessage $handle $::SCI_GETMODIFY 0 0]
        if { $value } {
                set text [$::statusbar cget -text]
                $::statusbar configure -text "$text Modified"
        }
        
        set value [SendMessage $handle $::SCI_GETOVERTYPE 0 0]
        set text [$::statusbar cget -text]
        if { $value } {
                $::statusbar configure -text "$text Overwrite"
        } else {
                $::statusbar configure -text "$text Insert"
        }
        
        set value [SendMessage $handle $::SCI_GETREADONLY 0 0]
        set text [$::statusbar cget -text]
        if { $value } {
                $::statusbar configure -text "$text Readonly"
        }

        set lineCount [SendMessage $handle $::SCI_GETLINECOUNT 0 0]
        set tmp "${lineCount}0"
        set width [SendMessage $handle $::SCI_TEXTWIDTH $::STYLE_LINENUMBER [charp_to_long $tmp]]
        SendMessage $handle $::SCI_SETMARGINWIDTHN 0 $width

    HighlightBrace $w
                        
        set style [SendMessage $handle $::SCI_GETSTYLEAT $pos 0]
        if { $style == $::SCE_TCL_WORD } {
                set start [SendMessage $handle $::SCI_WORDSTARTPOSITION $pos 0]
                set end [SendMessage $handle $::SCI_WORDENDPOSITION $pos 0]
                set token [GetTextRange $w $start $end]
                puts $token
        }
}

proc Init {handle} {
        SendMessage $handle $::SCI_STYLECLEARALL 0 0

        SendMessage $handle $::SCI_SETLEXER $::SCLEX_TCL 0
        SendMessage $handle $::SCI_SETMOUSEDWELLTIME 500 0
        SendMessage $handle $::SCI_USEPOPUP 0 0

        # line number
        SendMessage $handle $::SCI_SETMARGINTYPEN 0 $::SC_MARGIN_NUMBER
        SendMessage $handle $::SCI_SETMARGINWIDTHN 0 20
        SendMessage $handle $::SCI_SETMARGINSENSITIVEN 0 1

        # fold
        SendMessage $handle $::SCI_SETFOLDFLAGS 16 0
        SendMessage $handle $::SCI_SETMARGINTYPEN 2 $::SC_MARGIN_SYMBOL
        SendMessage $handle $::SCI_SETMARGINWIDTHN 2 16
        SendMessage $handle $::SCI_SETMARGINMASKN 2 $::SC_MASK_FOLDERS
        SendMessage $handle $::SCI_SETMARGINSENSITIVEN 2 1

        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "fold"] [charp_to_long "1"]
        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "fold.comment"] [charp_to_long "1"]
        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "fold.compact"] [charp_to_long "1"]
        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "fold.preprocessor"] [charp_to_long "1"]
        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "fold.at.else"] [charp_to_long "1"]
        SendMessage $handle $::SCI_SETPROPERTY \
                [charp_to_long "tcl.default.language"] [charp_to_long "1"]

        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDEROPEN $::SC_MARK_BOXMINUS
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDER $::SC_MARK_BOXPLUS
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDERSUB $::SC_MARK_VLINE
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDERTAIL $::SC_MARK_LCORNER
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDEREND $::SC_MARK_BOXPLUSCONNECTED
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDEROPENMID $::SC_MARK_BOXMINUSCONNECTED
        SendMessage $handle $::SCI_MARKERDEFINE \
                $::SC_MARKNUM_FOLDERMIDTAIL $::SC_MARK_TCORNER

        SendMessage $handle $::SCI_CLEARCMDKEY 0 0
        SendMessage $handle $::SCI_ASSIGNCMDKEY \
                [merge_long [char_to_long +] $::SCMOD_CTRL] $::SCI_ZOOMIN
        SendMessage $handle $::SCI_ASSIGNCMDKEY \
                [merge_long [char_to_long -] $::SCMOD_CTRL] $::SCI_ZOOMOUT
}

set handle [$text GetHandle]
Init $handle
SetDefaultStyle $handle

set fd [open "test.tcl"]
set txt [read $fd]
close $fd

SendMessage $handle $::SCI_ADDTEXT [string length $txt] [charp_to_long $txt]
        
SendMessage $handle $::SCI_SETSAVEPOINT 0 0
SendMessage $handle $::SCI_EMPTYUNDOBUFFER 0 0