###################################################### # ProjMan 2 # Distributed under GNU Public License # Author: Sergey Kalinin svk@nuk-svk.ru # Copyright (c) "SVK", 2022, https://nuk-svk.ru ###################################################### # Editor module ###################################################### namespace eval Editor { variable selectionTex proc Comment {txt} { set selIndex [$txt tag ranges sel] set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] set PosNum [lindex [split $pos "."] 1] puts "Select : $selIndex" if {$selIndex != ""} { set lineBegin [lindex [split [lindex $selIndex 0] "."] 0] set lineEnd [lindex [split [lindex $selIndex 1] "."] 0] set posBegin [lindex [split [lindex $selIndex 1] "."] 0] set posEnd [lindex [split [lindex $selIndex 1] "."] 1] if {$lineEnd == $lineNum && $posEnd == 0} { set lineEnd [expr $lineEnd - 1] } for {set i $lineBegin} {$i <=$lineEnd} {incr i} { #$txt insert $i.0 "# " regexp -nocase -indices -- {^(\s*)(.*?)} [$txt get $i.0 $i.end] match v1 v2 $txt insert $i.[lindex [split $v2] 0] "# " } $txt tag add comments $lineBegin.0 $lineEnd.end $txt tag raise comments } else { regexp -nocase -indices -- {^(\s*)(.*?)} [$txt get $lineNum.0 $lineNum.end] match v1 v2 $txt insert $lineNum.[lindex [split $v2] 0] "# " $txt tag add comments $lineNum.0 $lineNum.end $txt tag raise comments } } proc Uncomment {txt} { set selIndex [$txt tag ranges sel] set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] set posNum [lindex [split $pos "."] 1] if {$selIndex != ""} { set lineBegin [lindex [split [lindex $selIndex 0] "."] 0] set lineEnd [lindex [split [lindex $selIndex 1] "."] 0] set posBegin [lindex [split [lindex $selIndex 1] "."] 0] set posEnd [lindex [split [lindex $selIndex 1] "."] 1] if {$lineEnd == $lineNum && $posEnd == 0} { set lineEnd [expr $lineEnd - 1] } for {set i $lineBegin} {$i <=$lineEnd} {incr i} { set str [$txt get $i.0 $i.end] if {[regexp -nocase -indices -- {(^| )(#\s)(.+)} $str match v1 v2 v3]} { $txt delete $i.[lindex [split $v2] 0] $i.[lindex [split $v3] 0] } } $txt tag remove comments $lineBegin.0 $lineEnd.end $txt tag add sel $lineBegin.0 $lineEnd.end $txt highlight $lineBegin.0 $lineEnd.end } else { #set posNum [lindex [split $pos "."] 1] set str [$txt get $lineNum.0 $lineNum.end] if {[regexp -nocase -indices -- {(^| )(#\s)(.+)} $str match v1 v2 v3]} { puts ">>>>> $v1, $v2, $v3" $txt delete $lineNum.[lindex [split $v2] 0] $lineNum.[lindex [split $v3] 0] #$txt insert $i.0 $v3 } $txt tag remove comments $lineNum.0 $lineNum.end $txt highlight $lineNum.0 $lineNum.end } } proc InsertTabular {txt} { global cfgVariables set selIndex [$txt tag ranges sel] set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] puts "Select : $selIndex" for {set i 0} {$i < $cfgVariables(tabSize)} { incr i} { append tabInsert " " } puts ">$tabInsert<" if {$selIndex != ""} { set lineBegin [lindex [split [lindex $selIndex 0] "."] 0] set lineEnd [lindex [split [lindex $selIndex 1] "."] 0] set posBegin [lindex [split [lindex $selIndex 1] "."] 0] set posEnd [lindex [split [lindex $selIndex 1] "."] 1] # if {$lineBegin == $lineNum} { # set lineBegin [expr $lineBegin + 1] # } if {$lineEnd == $lineNum || $posEnd == 0} { set lineEnd [expr $lineEnd - 1] } puts "Pos: $pos, Begin: $lineBegin, End: $lineEnd" for {set i $lineBegin} {$i <=$lineEnd} {incr i} { #$txt insert $i.0 "# " regexp -nocase -indices -- {^(\s*)(.*?)} [$txt get $i.0 $i.end] match v1 v2 $txt insert $i.[lindex [split $v2] 0] $tabInsert } $txt tag remove sel $lineBegin.$posBegin $lineEnd.$posEnd $txt tag add sel $lineBegin.0 $lineEnd.end $txt highlight $lineBegin.0 $lineEnd.end } else { # set pos [$txt index insert] # set lineNum [lindex [split $pos "."] 0] regexp -nocase -indices -- {^(\s*)(.*?)} [$txt get $lineNum.0 $lineNum.end] match v1 v2 puts "$v1<>$v2" $txt insert $lineNum.[lindex [split $v2] 0] $tabInsert } } proc DeleteTabular {txt} { global cfgVariables set selIndex [$txt tag ranges sel] set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] if {$selIndex != ""} { set lineBegin [lindex [split [lindex $selIndex 0] "."] 0] set lineEnd [lindex [split [lindex $selIndex 1] "."] 0] set posBegin [lindex [split [lindex $selIndex 1] "."] 0] set posEnd [lindex [split [lindex $selIndex 1] "."] 1] if {$lineEnd == $lineNum && $posEnd == 0} { set lineEnd [expr $lineEnd - 1] } for {set i $lineBegin} {$i <=$lineEnd} {incr i} { set str [$txt get $i.0 $i.end] if {[regexp -nocase -indices -- {(^\s*)(.*?)} $str match v1 v2]} { set posBegin [lindex [split $v1] 0] set posEnd [lindex [split $v1] 1] if {[expr $posEnd + 1] >= $cfgVariables(tabSize)} { $txt delete $i.$posBegin $i.$cfgVariables(tabSize) } } } $txt tag remove sel $lineBegin.$posBegin $lineEnd.$posEnd $txt tag add sel $lineBegin.0 $lineEnd.end $txt highlight $lineBegin.0 $lineEnd.end } else { set str [$txt get $lineNum.0 $lineNum.end] if {[regexp -nocase -indices -- {(^\s*)(.*?)} $str match v1]} { set posBegin [lindex [split $v1] 0] set posEnd [lindex [split $v1] 1] if {[expr $posEnd + 1] >= $cfgVariables(tabSize)} { $txt delete $lineNum.$posBegin $lineNum.$cfgVariables(tabSize) } } } } ## TABULAR INSERT (auto indent)## proc Indent {txt} { global cfgVariables # set tabSize 4 set indentSize $cfgVariables(tabSize) set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] set posNum [lindex [split $pos "."] 1] puts "$pos" if {$lineNum > 1} { # get current text set curText [$txt get $lineNum.0 "$lineNum.0 lineend"] #get text of prev line set prevLineNum [expr {$lineNum - 1}] set prevText [$txt get $prevLineNum.0 "$prevLineNum.0 lineend"] #count first spaces in current line set spaces "" regexp "^| *" $curText spaces #count first spaces in prev line set prevSpaces "" regexp "^( |\t)*" $prevText prevSpaces set len [string length $prevSpaces] set shouldBeSpaces 0 for {set i 0} {$i < $len} {incr i} { if {[string index $prevSpaces $i] == "\t"} { incr shouldBeSpaces $cfgVariables(tabSize) } else { incr shouldBeSpaces } } #see last symbol in the prev String. set lastSymbol [string index $prevText [expr {[string length $prevText] - 1}]] # is it open brace? if {$lastSymbol == ":" || $lastSymbol == "\\"} { incr shouldBeSpaces $indentSize } if {$lastSymbol == "\{"} { incr shouldBeSpaces $indentSize } set a "" regexp "^| *\}" $curText a if {$a != ""} { # make unindent if {$shouldBeSpaces >= $indentSize} { set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}] } } if {$lastSymbol == "\["} { incr shouldBeSpaces $indentSize } set a "" regexp "^| *\]" $curText a if {$a != ""} { # make unindent if {$shouldBeSpaces >= $indentSize} { set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}] } } if {$lastSymbol == "\("} { incr shouldBeSpaces $indentSize } set a "" regexp {^| *\)} $curText a if {$a != ""} { # make unindent if {$shouldBeSpaces >= $indentSize} { set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}] } } set spaceNum [string length $spaces] if {$shouldBeSpaces > $spaceNum} { #insert spaces set deltaSpace [expr {$shouldBeSpaces - $spaceNum}] set incSpaces "" for {set i 0} {$i < $deltaSpace} {incr i} { append incSpaces " " } $txt insert $lineNum.0 $incSpaces } elseif {$shouldBeSpaces < $spaceNum} { #delete spaces set deltaSpace [expr {$spaceNum - $shouldBeSpaces}] $txt delete $lineNum.0 $lineNum.$deltaSpace } } } proc SelectionPaste {txt} { set selBegin [lindex [$txt tag ranges sel] 0] set selEnd [lindex [$txt tag ranges sel] 1] if {$selBegin ne ""} { $txt delete $selBegin $selEnd $txt highlight $selBegin $selEnd #tk_textPaste $txt } } proc SelectionGet {txt} { variable selectionText set selBegin [lindex [$txt tag ranges sel] 0] set selEnd [lindex [$txt tag ranges sel] 1] if {$selBegin ne "" && $selEnd ne ""} { set selectionText [$txt get $selBegin $selEnd] } } proc ReleaseKey {k txt} { switch $k { Return { set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] set posNum [lindex [split $pos "."] 1] regexp {^(\s*)} [$txt get [expr $lineNum - 1].0 [expr $lineNum - 1].end] -> spaceStart # puts "$pos, $lineNum, $posNum, >$spaceStart<" $txt insert insert $spaceStart Editor::Indent $txt } } } proc PressKey {k txt} { # puts [Editor::Key $k] switch $k { apostrophe { QuotSelection $txt {'} } quotedbl { QuotSelection $txt {"} } grave { QuotSelection $txt {`} } parenleft { # QuotSelection $txt {)} } bracketleft { # QuotSelection $txt {]} } braceleft { # {QuotSelection} $txt {\}} } } } ## GET KEYS CODE ## proc Key {key str} { puts "Pressed key code: $key, $str" if {$key >= 10 && $key <= 22} {return "true"} if {$key >= 24 && $key <= 36} {return "true"} if {$key >= 38 && $key <= 50} {return "true"} if {$key >= 51 && $key <= 61 && $key != 58} {return "true"} if {$key >= 79 && $key <= 91} {return "true"} if {$key == 63 || $key == 107 || $key == 108 || $key == 112} {return "true"} } proc BindKeys {w} { global cfgVariables # variable txt set txt $w.frmText.t bind $txt "Editor::ReleaseKey %K $txt" bind $txt "Editor::PressKey %K $txt" # bind $txt "Editor::Key %k %K" #$txt tag bind Sel {puts ">>>>>>>>>>>>>>>>>>>"} #bind $txt {puts "/////////////////"} # #bind $txt GoToLine # bind $txt {focus .frmTool.frmGoto.entGoTo; .frmTool.frmGoto.entGoTo delete 0 end} # bind $txt Find # bind $txt Find # bind $txt {FindNext $w.text 1} # bind $txt ReplaceDialog # bind $txt ReplaceDialog # bind $txt {ReplaceCommand $w.text 1} # bind $txt {FileDialog [$noteBookFiles raise] save} # bind $txt {FileDialog [$noteBookFiles raise] save} # bind $txt {FileDialog [$noteBookFiles raise] save_as} # bind $txt {FileDialog [$noteBookFiles raise] save_as} bind $txt FileOper::Close bind $txt FileOper::Close # bind $txt "tk_textCut $w.text;break" # bind $txt "tk_textCut $w.text;break" # bind $txt "tk_textCopy $txt" # bind $txt "tk_textCopy $txt" bind $txt "Editor::SelectionPaste $txt" bind $txt "Editor::SelectionPaste $txt" #bind $txt "auto_completition $txt" #bind $txt "auto_completition $txt" bind $txt "auto_completition_proc $txt" bind $txt "auto_completition_proc $txt" bind $txt "ImageBase64Encode $txt" bind $txt "Editor::InsertTabular $txt" bind $txt "Editor::DeleteTabular $txt" bind $txt "Editor::Comment $txt" bind $txt "Editor::Uncomment $txt" bind $txt Find #bind . PageTab #bind . PageTab bind $txt {OverWrite} bind $txt [] bind $txt {catch [PopupMenuEditor %X %Y]} bind $txt "%W yview scroll -3 units" bind $txt "%W yview scroll 3 units" #bind $txt "%W xview scroll -2 units" #bind $txt "%W xview scroll 2 units" bind $txt <> "SetModifiedFlag $w" bind $txt <> "Editor::SelectionGet $txt" bind $txt ImageBase64Encode } proc QuotSelection {txt symbol} { variable selectionText set selIndex [$txt tag ranges sel] set pos [$txt index insert] set lineNum [lindex [split $pos "."] 0] set posNum [lindex [split $pos "."] 1] set symbol [string trim [string trimleft $symbol "\\"]] # puts "Selindex : $selIndex, cursor position: $pos" if {$selIndex != ""} { set lineBegin [lindex [split [lindex $selIndex 0] "."] 0] set posBegin [lindex [split [lindex $selIndex 0] "."] 1] set lineEnd [lindex [split [lindex $selIndex 1] "."] 0] set posEnd [lindex [split [lindex $selIndex 1] "."] 1] # set selText [$txt get $lineBegin.$posBegin $lineEnd.$posEnd] set selText $selectionText puts "Selected text: $selText, pos: $pos, lineBegin: $lineBegin, posBegin: $posBegin, pos end: $posEnd" if {$posNum == $posEnd} { $txt insert $lineBegin.$posBegin "$symbol" } if {$posNum == $posBegin} { $txt insert $lineBegin.$posEnd "$symbol" } $txt highlight $lineBegin.$posBegin $lineEnd.end # $txt insert $lineBegin.[expr $posBegin + 1] "$symbol" } else { # $txt insert $lineNum.[expr $posNum + 1] "$symbol" # $txt mark set insert $lineNum.[expr $posNum - 1] # # $txt see $lineNum.[expr $posNum - 1] # $txt see insert # $txt highlight $lineNum.$posNum $lineNum.end } } # Create editor for new file (Ctrl+N) proc New {} { global nbEditor tree untitledNumber if [info exists untitledNumber] { incr untitledNumber 1 } else { set untitledNumber 0 } # set filePath untitled-$untitledNumber # set fileName untitled-$untitledNumber set fileFullPath untitled-$untitledNumber #puts [Tree::InsertItem $tree {} $fileFullPath "file" $fileName] set nbEditorItem [NB::InsertItem $nbEditor $fileFullPath "file"] # puts "$nbEditorItem, $nbEditor" Editor $fileFullPath $nbEditor $nbEditorItem SetModifiedFlag $nbEditorItem } proc ReadStructure {txt treeItemName} { global tree nbEditor for {set lineNumber 0} {$lineNumber <= [$txt count -lines 0.0 end]} {incr lineNumber} { set line [$txt get $lineNumber.0 $lineNumber.end] # TCL procedure if {[regexp -nocase -all -- {^\s*?(proc) (::|)(\w+)(::|)(\w+)\s*?(\{|\()(.*)(\}|\)) \{} $line match v1 v2 v3 v4 v5 v6 params v8]} { set procName "$v2$v3$v4$v5" # lappend procList($activeProject) [list $procName [string trim $params]] puts "$treeItemName proc $procName $params" # tree parent item type text puts [Tree::InsertItem $tree $treeItemName $procName "func" "$procName ($params)"] } # GO function if {[regexp -nocase -all -- {^\s*?func\s*?\((\w+\s*?\*\w+)\)\s*?(\w+)\((.*?)\)\s*?\((.*?)\)} $line match v1 funcName params returns]} { # set procName "$v2$v3$v4$v5" # lappend procList($activeProject) [list $procName [string trim $params]] if {$v1 ne ""} { set linkName [lindex [split $v1 " "] 1] set funcName "\($linkName\).$funcName" } puts "$treeItemName proc $funcName $params" # tree parent item type text puts [Tree::InsertItem $tree $treeItemName $funcName "func" "$funcName ($params)"] } if {[regexp -nocase -all -- {^\s*?func\s*?(\w+)\((.*?)\) (\(\w+\)|\w+|)\s*?\{} $line match funcName params returns]} { puts "$treeItemName proc $funcName $params" # tree parent item type text puts [Tree::InsertItem $tree $treeItemName $funcName "func" "$funcName ($params)"] } } } proc Editor {fileFullPath nb itemName} { global cfgVariables set fr $itemName if ![string match "*untitled*" $itemName] { set lblText $fileFullPath } else { set lblText "" } set lblName "lbl[string range $itemName [expr [string last "." $itemName] +1] end]" ttk::label $fr.$lblName -text $lblText pack $fr.$lblName -side top -anchor w -fill x set frmText [ttk::frame $fr.frmText -border 1] set txt $frmText.t pack $frmText -side top -expand true -fill both pack [ttk::scrollbar $frmText.s -command "$frmText.t yview"] -side right -fill y ctext $txt -yscrollcommand "$frmText.s set" -font $cfgVariables(font) -linemapfg $cfgVariables(lineNumberFG) \ -tabs "[expr {4 * [font measure $cfgVariables(font) 0]}] left" -tabstyle tabular -undo true pack $txt -fill both -expand 1 # puts ">>>>>>> [bindtags $txt]" if {$cfgVariables(lineNumberShow) eq "false"} { $txt configure -linemap 0 } set fileType [string toupper [string trimleft [file extension $fileFullPath] "."]] # puts ">$fileType<" # puts [info procs Highlight::GO] if {[info procs ::Highlight::$fileType] ne ""} { Highlight::$fileType $txt } else { Highlight::Default $txt } BindKeys $itemName # bind $txt { # regexp {^(\s*)} [%W get "insert linestart" end] -> spaceStart # %W insert insert "\n$spaceStart" # break # } return $fr } } # ctextBindings.tcl # # Copyright (C) 2012 Sedat Serper # A similar script and functionality is implemented in tGĀ² as of v1.06.01.41 # # proc ctext_binding4Tag {w tags} { # # foreach tag $tags { # $w tag bind $tag {%W config -cursor hand2} # $w tag bind $tag {%W config -cursor xterm} # $w tag bind $tag { # set cur [::tk::TextClosestGap %W %x %y] # if {[catch {%W index anchor}]} {%W mark set anchor $cur} # set anchor [%W index anchor] # set last [::tk::TextNextPos %W "$cur - 1c" tcl_wordBreakAfter] # set first [::tk::TextPrevPos %W anchor tcl_wordBreakBefore] # if {![catch {set tmp [%W get $first $last]}]} { # ctext_execTagCmd $tmp # } # } # } # } # # # THE DEMO # # # ----------------------- demo ------------------------------------------- # # Open a new wish console and copy/paste the following complete script. # # Clicking on parts that are highlighted and observe the console output... # # Adjust procedure 'ctext_execTagCmd' to customize the handling 4 your application. # package require ctext # pack [ctext .t] -fill both -expand 1 # ctext::addHighlightClass .t bindings purple [list ] # ctext::addHighlightClass .t commands orange [list foreach proc if set catch] # .t fastinsert end [info body ctext_binding4Tag] # .t highlight 1.0 end # ctext_binding4Tag .t {bindings commands}