projman/lib/editor.tcl

846 lines
34 KiB
Tcl
Raw Normal View History

2022-07-21 10:56:46 +03:00
######################################################
# ProjMan 2
# Distributed under GNU Public License
# Author: Sergey Kalinin svk@nuk-svk.ru
# Copyright (c) "SVK", 2022, https://nuk-svk.ru
######################################################
# Editor module
######################################################
2018-02-05 11:24:14 +03:00
2022-07-21 10:56:46 +03:00
namespace eval Editor {
variable selectionTex
proc Comment {txt fileType} {
global lexers
2022-07-21 10:56:46 +03:00
set selIndex [$txt tag ranges sel]
set pos [$txt index insert]
set lineNum [lindex [split $pos "."] 0]
set PosNum [lindex [split $pos "."] 1]
# switch $fileType {
# TCL {
# set symbol "#"
# }
# GO {
# set symbol "//"
# }
# Unknown {
# set symbol "#"
# }
# default {
# set symbol "#"
# }
# }
if [dict exists $lexers $fileType commentSymbol] {
set symbol [dict get $lexers $fileType commentSymbol]
} else {
set symbol "#"
}
2022-07-21 10:56:46 +03:00
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} {
2022-07-21 10:56:46 +03:00
set lineEnd [expr $lineEnd - 1]
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
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] "$symbol "
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
$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] "$symbol "
2022-07-21 10:56:46 +03:00
$txt tag add comments $lineNum.0 $lineNum.end
$txt tag raise comments
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
}
proc Uncomment {txt fileType} {
2022-07-21 10:56:46 +03:00
set selIndex [$txt tag ranges sel]
set pos [$txt index insert]
set lineNum [lindex [split $pos "."] 0]
set posNum [lindex [split $pos "."] 1]
if {[info procs GetComment:$fileType] ne ""} {
set commentProcedure "GetComment:$fileType"
} else {
set commentProcedure {GetComment:Unknown}
}
# set commentProcedure "GetComment"
# puts "$fileType, $commentProcedure"
2022-07-21 10:56:46 +03:00
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} {
2022-07-21 10:56:46 +03:00
set lineEnd [expr $lineEnd - 1]
}
for {set i $lineBegin} {$i <=$lineEnd} {incr i} {
set str [$txt get $i.0 $i.end]
set commentSymbolIndex [$commentProcedure $str]
if {$commentSymbolIndex != 0} {
$txt delete $i.[lindex $commentSymbolIndex 0] $i.[lindex $commentSymbolIndex 1]
2018-02-05 11:24:14 +03:00
}
}
$txt tag remove comments $lineBegin.0 $lineEnd.end
$txt tag add sel $lineBegin.0 $lineEnd.end
$txt highlight $lineBegin.0 $lineEnd.end
2022-07-21 10:56:46 +03:00
} else {
set posNum [lindex [split $pos "."] 1]
2022-07-21 10:56:46 +03:00
set str [$txt get $lineNum.0 $lineNum.end]
set commentSymbolIndex [$commentProcedure $str]
if {$commentSymbolIndex != 0} {
$txt delete $lineNum.[lindex $commentSymbolIndex 0] $lineNum.[lindex $commentSymbolIndex 1]
2022-07-21 10:56:46 +03:00
}
$txt tag remove comments $lineNum.0 $lineNum.end
$txt highlight $lineNum.0 $lineNum.end
2018-02-05 11:24:14 +03:00
}
}
proc GetComment {fileType str} {
global lexers
puts [dict get $lexers $fileType commentSymbol]
if {[dict exists $lexers $fileType commentSymbol] == 0} {
return
}
if {[regexp -nocase -indices -- {(^| )([dict get $lexers $fileType commentSymbol]\s)(.+)} $str match v1 v2 v3]} {
puts "$match, $v1, $v2, $v3"
return [list [lindex [split $v2] 0] [lindex [split $v3] 0]]
} else {
puts "FUCK"
return 0
}
}
proc GetComment:TCL {str} {
if {[regexp -nocase -indices -- {(^| )(#\s)(.+)} $str match v1 v2 v3]} {
return [list [lindex [split $v2] 0] [lindex [split $v3] 0]]
} else {
return 0
}
}
proc GetComment:GO {str} {
# puts ">>>>>>>$str"
if {[regexp -nocase -indices -- {(^| |\t)(//\s)(.+)} $str match v1 v2 v3]} {
# puts ">>>> $match $v1 $v2 $v3"
return [list [lindex [split $v2] 0] [lindex [split $v3] 0]]
} else {
return 0
}
}
proc GetComment:Unknown {str} {
if {[regexp -nocase -indices -- {(^| )(#\s)(.+)} $str match v1 v2 v3]} {
return [list [lindex [split $v2] 0] [lindex [split $v3] 0]]
} else {
return 0
}
}
2018-02-05 11:24:14 +03:00
2022-07-21 10:56:46 +03:00
proc InsertTabular {txt} {
global cfgVariables
set selIndex [$txt tag ranges sel]
set pos [$txt index insert]
set lineNum [lindex [split $pos "."] 0]
2018-02-05 11:24:14 +03:00
2022-07-21 10:56:46 +03:00
puts "Select : $selIndex"
for {set i 0} {$i < $cfgVariables(tabSize)} { incr i} {
append tabInsert " "
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
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
2018-02-05 11:24:14 +03:00
} else {
2022-07-21 10:56:46 +03:00
# 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
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
}
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
2018-02-05 11:24:14 +03:00
} else {
2022-07-21 10:56:46 +03:00
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)
}
}
2018-02-05 11:24:14 +03:00
}
}
2022-07-21 10:56:46 +03:00
## 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)
2022-07-21 10:56:46 +03:00
} else {
incr shouldBeSpaces
}
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
#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
2018-02-08 11:07:14 +03:00
}
2022-07-21 10:56:46 +03:00
if {$lastSymbol == "\{"} {
incr shouldBeSpaces $indentSize
2018-02-08 11:07:14 +03:00
}
2022-07-21 10:56:46 +03:00
set a ""
regexp "^| *\}" $curText a
if {$a != ""} {
# make unindent
if {$shouldBeSpaces >= $indentSize} {
set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}]
}
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
if {$lastSymbol == "\["} {
incr shouldBeSpaces $indentSize
}
set a ""
regexp "^| *\]" $curText a
if {$a != ""} {
# make unindent
if {$shouldBeSpaces >= $indentSize} {
set shouldBeSpaces [expr {$shouldBeSpaces - $indentSize}]
2018-02-05 11:24:14 +03:00
}
}
2022-07-21 10:56:46 +03:00
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 " "
2018-02-05 11:24:14 +03:00
}
2022-07-21 10:56:46 +03:00
$txt insert $lineNum.0 $incSpaces
} elseif {$shouldBeSpaces < $spaceNum} {
#delete spaces
set deltaSpace [expr {$spaceNum - $shouldBeSpaces}]
$txt delete $lineNum.0 $lineNum.$deltaSpace
}
2018-02-05 11:24:14 +03:00
}
}
2022-07-21 10:56:46 +03:00
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
2018-02-05 11:24:14 +03:00
}
}
2022-07-21 10:56:46 +03:00
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 SelectionHighlight {txt} {
variable selectionText
$txt tag remove lightSelected 1.0 end
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]
# set selBeginRow [lindex [split $selBegin "."] 1]
# set selEndRow [lindex [split $selEnd "."] 1]
# puts "$selBegin, $selBeginRow; $selEnd, $selEndRow"
# set symNumbers [expr $selEndRow - $selBeginRow]
set symNumbers [expr [lindex [split $selEnd "."] 1] - [lindex [split $selBegin "."] 1]]
# puts "Selection $selectionText"
if {$selectionText eq "-"} {
set selectionText "\\$selectionText"
}
set lstFindIndex [$txt search -all "$selectionText" 0.0]
foreach ind $lstFindIndex {
set selFindLine [lindex [split $ind "."] 0]
set selFindRow [lindex [split $ind "."] 1]
set endInd "$selFindLine.[expr $selFindRow + $symNumbers]"
# puts "$ind; $symNumbers; $selFindLine, $selFindRow; $endInd "
$txt tag add lightSelected $ind $endInd
}
}
}
2022-07-21 10:56:46 +03:00
proc ReleaseKey {k txt} {
set pos [$txt index insert]
SearchBrackets $txt
2022-07-21 10:56:46 +03:00
switch $k {
Return {
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
}
}
set lpos [split $pos "."]
set lblText "[::msgcat::mc "Row"]: [lindex $lpos 0], [::msgcat::mc "Column"]: [lindex $lpos 1]"
.frmStatus.lblPosition configure -text $lblText
unset lpos
$txt tag remove lightSelected 1.0 end
2022-07-21 10:56:46 +03:00
}
proc PressKey {k txt} {
# puts [Editor::Key $k]
switch $k {
apostrophe {
QuotSelection $txt {'}
2018-02-07 15:49:20 +03:00
}
2022-07-21 10:56:46 +03:00
quotedbl {
QuotSelection $txt {"}
}
grave {
QuotSelection $txt {`}
}
parenleft {
# QuotSelection $txt {)}
}
bracketleft {
# QuotSelection $txt {]}
}
braceleft {
# {QuotSelection} $txt {\}}
2018-02-07 15:49:20 +03:00
}
}
}
2022-07-21 10:56:46 +03:00
## 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 fileType} {
2022-07-21 10:56:46 +03:00
global cfgVariables
# variable txt
set txt $w.frmText.t
bind $txt <KeyRelease> "Editor::ReleaseKey %K $txt"
bind $txt <KeyPress> "Editor::PressKey %K $txt"
# bind $txt <KeyRelease> "Editor::Key %k %K"
#$txt tag bind Sel <Control-/> {puts ">>>>>>>>>>>>>>>>>>>"}
#bind $txt <Control-slash> {puts "/////////////////"}
# #bind $txt <Control-g> GoToLine
# bind $txt <Control-g> {focus .frmTool.frmGoto.entGoTo; .frmTool.frmGoto.entGoTo delete 0 end}
# bind $txt <Control-agrave> Find
# bind $txt <Control-f> Find
# bind $txt <F3> {FindNext $w.text 1}
# bind $txt <Control-ecircumflex> ReplaceDialog
# bind $txt <Control-r> ReplaceDialog
# bind $txt <F4> {ReplaceCommand $w.text 1}
# bind $txt <Control-ucircumflex> {FileDialog [$noteBookFiles raise] save}
# bind $txt <Control-s> {FileDialog [$noteBookFiles raise] save}
# bind $txt <Control-ocircumflex> {FileDialog [$noteBookFiles raise] save_as}
# bind $txt <Shift-Control-s> {FileDialog [$noteBookFiles raise] save_as}
bind $txt <Control-odiaeresis> FileOper::Close
bind $txt <Control-w> FileOper::Close
# bind $txt <Control-division> "tk_textCut $w.text;break"
# bind $txt <Control-x> "tk_textCut $w.text;break"
# bind $txt <Control-ntilde> "tk_textCopy $txt"
# bind $txt <Control-c> "tk_textCopy $txt"
bind $txt <Control-igrave> "Editor::SelectionPaste $txt"
bind $txt <Control-v> "Editor::SelectionPaste $txt"
#bind $txt <Control-adiaeresis> "auto_completition $txt"
#bind $txt <Control-l> "auto_completition $txt"
# bind $txt <Control-icircumflex> ""
# bind $txt <Control-j> ""
2022-07-21 10:56:46 +03:00
bind $txt <Control-i> "ImageBase64Encode $txt"
bind $txt <Control-bracketleft> "Editor::InsertTabular $txt"
bind $txt <Control-bracketright> "Editor::DeleteTabular $txt"
bind $txt <Control-comma> "Editor::Comment $txt $fileType"
bind $txt <Control-period> "Editor::Uncomment $txt $fileType"
2022-07-21 10:56:46 +03:00
bind $txt <Control-eacute> Find
#bind . <Control-m> PageTab
#bind . <Control-udiaeresis> PageTab
bind $txt <Insert> {OverWrite}
bind $txt <ButtonRelease-1> "Editor::SearchBrackets $txt"
# bind <Button-1> [bind sysAfter <Any-Key>]
# bind $txt <Button-3> {catch [PopupMenuEditor %X %Y]}
# bind $txt <Button-4> "%W yview scroll -3 units"
# bind $txt <Button-5> "%W yview scroll 3 units"
2022-07-21 10:56:46 +03:00
#bind $txt <Shift-Button-4> "%W xview scroll -2 units"
#bind $txt <Shift-Button-5> "%W xview scroll 2 units"
bind $txt <Button-1><ButtonRelease-1> "Editor::SelectionHighlight $txt"
2022-07-21 10:56:46 +03:00
bind $txt <<Modified>> "SetModifiedFlag $w"
bind $txt <<Selection>> "Editor::SelectionGet $txt"
bind $txt <Control-i> ImageBase64Encode
bind $txt <Control-u> "Editor::SearchBrackets %W"
bind $txt <Control-F> "Editor::GoToFunction $w"
bind $txt <Control-f> "Editor::GoToFunction $w"
}
proc SearchBrackets {txt} {
set i -1
catch {
switch -- [$txt get "insert - 1 chars"] {
\{ {set i [Editor::_searchCloseBracket $txt \{ \} insert end]}
\[ {set i [Editor::_searchCloseBracket $txt \[ \] insert end]}
( {set i [Editor::_searchCloseBracket $txt ( ) insert end]}
\} {set i [Editor::_searchOpenBracket $txt \{ \} insert 1.0]}
\] {set i [Editor::_searchOpenBracket $txt \[ \] insert 1.0]}
) {set i [Editor::_searchOpenBracket $txt ( ) insert 1.0]}
} ;# switch
catch { $txt tag remove lightBracket 1.0 end }
if { $i != -1 } {
# puts $i
$txt tag add lightBracket "$i - 1 chars" $i
};#if
};#catch
}
2022-07-21 10:56:46 +03:00
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"
}
2022-07-21 10:56:46 +03:00
$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
}
}
2022-07-21 10:56:46 +03:00
# 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
2022-07-21 10:56:46 +03:00
set fileFullPath untitled-$untitledNumber
#puts [Tree::InsertItem $tree {} $fileFullPath "file" $fileName]
set nbEditorItem [NB::InsertItem $nbEditor $fileFullPath "file"]
# puts "$nbEditorItem, $nbEditor"
2022-07-21 10:56:46 +03:00
Editor $fileFullPath $nbEditor $nbEditorItem
SetModifiedFlag $nbEditorItem
2022-07-21 10:56:46 +03:00
}
proc ReadStructure {txt treeItemName} {
global tree nbEditor editors lexers
set fileType [dict get $editors $txt fileType]
set l ""
if {[dict exists $lexers $fileType] == 0} {return}
for {set lineNumber 0} {$lineNumber <= [$txt count -lines 0.0 end]} {incr lineNumber} {
set line [$txt get $lineNumber.0 $lineNumber.end]
if {[dict exists $lexers $fileType procRegexpCommand] != 0 } {
if {[eval [dict get $lexers $fileType procRegexpCommand]]} {
set procName_ [string trim $procName]
puts [Tree::InsertItem $tree $treeItemName $procName_ "procedure" "$procName_ ($params)"]
lappend l [list $procName_ $params]
}
}
}
dict set editors $txt procedureList $l
}
proc FindFunction {findString} {
global nbEditor
puts $findString
set pos "0.0"
set txt [$nbEditor select].frmText.t
$txt see $pos
set line [lindex [split $pos "."] 0]
set x [lindex [split $pos "."] 1]
# set pos [$txt search -nocase $findString $line.$x end]
set pos [$txt search -nocase -regexp $findString $line.$x end]
$txt mark set insert $pos
$txt see $pos
puts $pos
# highlight the found word
set line [lindex [split $pos "."] 0]
# set x [lindex [split $pos "."] 1]
# set x [expr {$x + [string length $findString]}]
$txt tag remove sel 1.0 end
$txt tag add sel $pos $line.end
# #$text tag configure sel -background $editor(selectbg) -foreground $editor(fg)
$txt tag raise sel
focus -force $txt.t
# Position
return 1
}
# "Alexander Dederer (aka Korwin)
## Search close bracket in editor widget
proc _searchCloseBracket { widget o_bracket c_bracket start_pos end_pos } {
# puts "_searchCloseBracket: $widget $o_bracket $c_bracket $start_pos $end_pos"
set o_count 1
set c_count 0
set found 0
set pattern "\[\\$o_bracket\\$c_bracket\]"
set pos [$widget search -regexp -- $pattern $start_pos $end_pos]
while { ! [string equal $pos {}] } {
set char [$widget get $pos]
#tk_messageBox -title $pattern -message "char: $char; $pos; o_count=$o_count; c_count=$c_count"
if {[string equal $char $o_bracket]} {incr o_count ; set found 1}
if {[string equal $char $c_bracket]} {incr c_count ; set found 1}
if {($found == 1) && ($o_count == $c_count) } { return [$widget index "$pos + 1 chars"] }
set found 0
set start_pos "$pos + 1 chars"
set pos [$widget search -regexp -- $pattern $start_pos $end_pos]
} ;# while search
return -1
} ;# proc _searchCloseBracket
# "Alexander Dederer (aka Korwin)
## Search open bracket in editor widget
proc _searchOpenBracket { widget o_bracket c_bracket start_pos end_pos } {
# puts "_searchOpenBracket: $widget $o_bracket $c_bracket $start_pos $end_pos"
set o_count 0
set c_count 1
set found 0
set pattern "\[\\$o_bracket\\$c_bracket\]"
set pos [$widget search -backward -regexp -- $pattern "$start_pos - 1 chars" $end_pos]
# puts "$pos"
while { ! [string equal $pos {}] } {
set char [$widget get $pos]
# tk_messageBox -title $pattern -message "char: $char; $pos; o_count=$o_count; c_count=$c_count"
if {[string equal $char $o_bracket]} {incr o_count ; set found 1}
if {[string equal $char $c_bracket]} {incr c_count ; set found 1}
if {($found == 1) && ($o_count == $c_count) } { return [$widget index "$pos + 1 chars"]}
set found 0
set start_pos "$pos - 0 chars"
set pos [$widget search -backward -regexp -- $pattern $start_pos $end_pos]
} ;# while search
return -1
}
# ----------------------------------------------------------------------
# Вызов диалога со списком процедур или функций присутствующих в тексте
proc GoToFunction { w } {
global tree editors
set txt $w.frmText.t
# set start_word [$txt get "insert - 1 chars wordstart" insert]
set box [$txt bbox insert]
set box_x [expr [lindex $box 0] + [winfo rootx $txt] ]
set box_y [expr [lindex $box 1] + [winfo rooty $txt] + [lindex $box 3] ]
set l ""
# bindtags $txt [list GoToFunctionBind [winfo toplevel $txt] $txt Text sysAfter all]
# bind GoToFunctionBind <Escape> "bindtags $txt {[list [winfo toplevel $txt] $txt Text sysAfter all]}; catch { destroy .gotofunction; break}"
# bind GoToFunctionBind <Key> { Editor::GoToFunctionKey %W %K %A ; break}
# puts [array names editors]
foreach item [dict get $editors $txt procedureList] {
# puts $item
lappend l [lindex $item 0]
}
if {$l ne ""} {
eval GotoFunctionDialog $w $box_x $box_y [lsort $l]
focus .gotofunction.lBox
}
}
# proc GoToFunctionKey { txt K A } {
# set win .gotofunction
# set ind [$win.lBox curselection]
# puts "$txt $K $A"
# switch -- $K {
# Prior {
# set up [expr [$win.lBox index active] - [$win.lBox cget -height]]
# if { $up < 0 } { set up 0 }
# $win.lBox activate $up
# $win.lBox selection clear 0 end
# $win.lBox selection set $up $up
# }
# Next {
# set down [expr [$win.lBox index active] + [$win.lBox cget -height]]
# if { $down >= [$win.lBox index end] } { set down end }
# $win.lBox activate $down
# $win.lBox selection clear 0 end
# $win.lBox selection set $down $down
# }
# Up {
# set up [expr [$win.lBox index active] - 1]
# if { $up < 0 } { set up 0 }
# $win.lBox activate $up
# $win.lBox selection clear 0 end
# $win.lBox selection set $up $up
# }
# Down {
# set down [expr [$win.lBox index active] + 1]
# if { $down >= [$win.lBox index end] } { set down end }
# $win.lBox activate $down
# $win.lBox selection clear 0 end
# $win.lBox selection set $down $down
# }
# Return {
# Editor::FindFunction "proc $values"
# eval [bind GoToFunctionBind <Escape>]
# }
# default {
# $txt insert "insert" $A
# eval [bind GoToFunctionBind <Escape>]
# }
# }
# }
# ------------------------------------------------------------------------
# Диалоговое окно со списком процедур или функций в редактируемом тексте
proc GotoFunctionDialog {w x y args} {
global editors lexers
variable txt
variable win
set txt $w.frmText.t
set win .gotofunction
if { [winfo exists $win] } { destroy $win }
toplevel $win
wm transient $win .
wm overrideredirect $win 1
listbox $win.lBox -width 30 -border 2 -yscrollcommand "$win.yscroll set" -border 1
ttk::scrollbar $win.yscroll -orient vertical -command "$win.lBox yview"
pack $win.lBox -expand true -fill y -side left
pack $win.yscroll -side left -expand false -fill y
foreach { word } $args {
$win.lBox insert end $word
}
catch { $win.lBox activate 0 ; $win.lBox selection set 0 0 }
if { [set height [llength $args]] > 10 } { set height 10 }
$win.lBox configure -height $height
bind $win <Escape> {
destroy $Editor::win
focus -force $Editor::txt.t
break
}
bind $win.lBox <Escape> {
destroy $Editor::win
focus -force $Editor::txt.t
break
}
bind $win.lBox <Return> {
set findString [dict get $lexers [dict get $editors $Editor::txt fileType] procFindString]
set values [.gotofunction.lBox get [.gotofunction.lBox curselection]]
regsub -all {PROCNAME} $findString $values str
Editor::FindFunction "$str"
destroy .gotofunction
$Editor::txt tag remove sel 1.0 end
# focus $Editor::txt.t
break
}
wm geom $win +$x+$y
}
2022-07-21 10:56:46 +03:00
proc Editor {fileFullPath nb itemName} {
global cfgVariables editors
2022-07-21 10:56:46 +03:00
set fr $itemName
if ![string match "*untitled*" $itemName] {
set lblText $fileFullPath
} else {
set lblText ""
2022-07-21 10:56:46 +03:00
}
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
2022-07-21 10:56:46 +03:00
set frmText [ttk::frame $fr.frmText -border 1]
set txt $frmText.t
2022-07-21 10:56:46 +03:00
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) -linemapbg $cfgVariables(lineNumberBG) \
-tabs "[expr {4 * [font measure $cfgVariables(font) 0]}] left" -tabstyle tabular -undo true \
-relief flat
2022-07-21 10:56:46 +03:00
pack $txt -fill both -expand 1
# puts ">>>>>>> [bindtags $txt]"
2022-07-21 10:56:46 +03:00
if {$cfgVariables(lineNumberShow) eq "false"} {
$txt configure -linemap 0
}
$txt tag configure lightBracket -background $cfgVariables(selectLightBg) -foreground #00ffff
$txt tag configure lightSelected -background $cfgVariables(selectLightBg) -foreground #00ffff
2022-07-21 10:56:46 +03:00
set fileType [string toupper [string trimleft [file extension $fileFullPath] "."]]
if {$fileType eq ""} {set fileType "Unknown"}
# puts ">$fileType<"
# puts [info procs Highlight::GO]
dict set editors $txt fileType $fileType
dict set editors $txt procedureList [list]
# puts ">>[dict get $editors $txt fileType]"
# puts ">>[dict get $editors $txt procedureList]"
# puts ">>>>> $editors"
if {[info procs ::Highlight::$fileType] ne ""} {
2022-07-21 10:56:46 +03:00
Highlight::$fileType $txt
} else {
Highlight::Default $txt
}
BindKeys $itemName $fileType
2022-07-21 10:56:46 +03:00
# bind $txt <Return> {
# regexp {^(\s*)} [%W get "insert linestart" end] -> spaceStart
# %W insert insert "\n$spaceStart"
# break
# }
2022-07-21 10:56:46 +03:00
return $fr
}
2022-07-21 10:37:19 +03:00
}
# 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 <Enter> {%W config -cursor hand2}
# $w tag bind $tag <Leave> {%W config -cursor xterm}
# $w tag bind $tag <ButtonRelease-1> {
# 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 <Enter> <Leave> <ButtonRelease-1>]
# 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}