From 1c7c2ec90efd1f10efcfffe344f443de6d764f0e Mon Sep 17 00:00:00 2001 From: svk Date: Wed, 28 Jan 2026 19:38:50 +0300 Subject: [PATCH] =?UTF-8?q?=D0=92=D1=8B=D0=BD=D0=B5=D1=81=20=D0=BA=D0=BE?= =?UTF-8?q?=D0=B4=20=D1=81=D0=B2=D1=8F=D0=B7=D0=B0=D0=BD=D0=BD=D1=8B=D0=B9?= =?UTF-8?q?=20=D1=81=20=D0=BE=D0=B1=D1=80=D0=B0=D0=B1=D0=BE=D1=82=D0=BA?= =?UTF-8?q?=D0=BE=D0=B9=20=D0=BF=D0=BE=D0=B4=D1=81=D0=BA=D0=B0=D0=B7=D0=BE?= =?UTF-8?q?=D0=BA=20=D0=BF=D1=80=D0=B8=20=D0=B2=D0=B2=D0=BE=D0=B4=D0=B5=20?= =?UTF-8?q?=D0=BF=D0=B5=D1=80=D0=B5=D0=BC=D0=B5=D0=BD=D0=BD=D1=8B=D1=85=20?= =?UTF-8?q?=D0=B8=20=D0=BF=D1=80=D0=BE=D1=86=D0=B5=D0=B4=D1=83=D1=80=20?= =?UTF-8?q?=D0=B2=20=D0=BE=D1=82=D0=B4=D0=B5=D0=BB=D1=8C=D0=BD=D1=8B=D0=B9?= =?UTF-8?q?=20=D0=BC=D0=BE=D0=B4=D1=83=D0=BB=D1=8C.=20=D0=98=D1=81=D0=BF?= =?UTF-8?q?=D1=80=D0=B0=D0=B2=D0=B8=D0=BB=20=D0=BD=D0=B5=D0=B4=D0=BE=D1=80?= =?UTF-8?q?=D0=B0=D0=B1=D0=BE=D1=82=D0=BA=D1=83=20=D0=BF=D1=80=D0=B8=20?= =?UTF-8?q?=D0=B2=D1=8B=D0=B1=D0=BE=D1=80=D0=B5=20=D0=B2=D0=B0=D1=80=D0=B8?= =?UTF-8?q?=D0=B0=D0=BD=D1=82=D0=B0=20=D0=B8=D0=B7=20=D1=81=D0=BF=D0=B8?= =?UTF-8?q?=D1=81=D0=BA=D0=B0=20=D0=B8=20=D0=B2=D1=81=D1=82=D0=B0=D0=B2?= =?UTF-8?q?=D0=BA=D0=B5=20=D0=B5=D0=B3=D0=BE=20=D0=B2=20=D1=82=D0=B5=D0=BA?= =?UTF-8?q?=D1=81=D1=82.=20=D0=98=D1=81=D0=BF=D1=80=D0=B0=D0=B2=D0=B8?= =?UTF-8?q?=D0=BB=20=D0=BE=D0=B1=D1=80=D0=B0=D0=B1=D0=BE=D1=82=D0=BA=D1=83?= =?UTF-8?q?=20=D0=BA=D0=BB=D0=B0=D0=B2=D0=B8=D1=88=20=D0=92=D0=B2=D0=B5?= =?UTF-8?q?=D1=80=20=D0=92=D0=BD=D0=B8=D0=B7=20=D0=92=D0=B2=D0=BE=D0=B4=20?= =?UTF-8?q?=D0=9E=D1=82=D0=BC=D0=B5=D0=BD=D0=B0=20=D0=B2=20=D0=BE=D0=BA?= =?UTF-8?q?=D0=BD=D0=B5=20=D1=81=D0=BE=20=D1=81=D0=BF=D0=B8=D1=81=D0=BA?= =?UTF-8?q?=D0=BE=D0=BC=20=D0=B2=D0=B0=D1=80=D0=B8=D0=B0=D0=BD=D1=82=D0=BE?= =?UTF-8?q?=D0=B2.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/editor.tcl | 282 +++++++------------------------------- lib/helper.tcl | 336 ++++++++++++++++++++++++++++++++++++++++++++++ lib/imgviewer.tcl | 2 +- 3 files changed, 387 insertions(+), 233 deletions(-) create mode 100644 lib/helper.tcl diff --git a/lib/editor.tcl b/lib/editor.tcl index 4c727c8..9326f6d 100644 --- a/lib/editor.tcl +++ b/lib/editor.tcl @@ -402,234 +402,7 @@ namespace eval Editor { } } - proc VarHelperKey { widget K A } { - set win .varhelper - # if { [winfo exists $win] == 0 } { return } - set ind [$win.lBox curselection] - # puts ">>>>>>>>>>>> VarHelperBind <<<<<<<<<<<<<<<<" - - 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 { - $widget delete "insert - 1 chars wordstart" "insert wordend - 1 chars" - $widget insert "insert" [$win.lBox get [$win.lBox curselection]] - # eval [bind VarHelperBind ] - Editor::VarHelperEscape $widget - } - default { - $widget insert "insert" $A - # eval [bind VarHelperBind ] - Editor::VarHelperEscape $widget - } - } - } ;# proc auto_completition_key - proc VarHelperEscape {w} { - # puts ">>>>>>>>>>>> VarHelperEscape <<<<<<<<<<<<<<<<" - # bindtags $w [list [winfo parent $w] $w Text sysAfter all] - bindtags $w [list [winfo toplevel $w] $w Ctext sysAfter all] - catch { destroy .varhelper } - DebugPuts [bindtags $w] - DebugPuts [bind $w] - } - proc VarHelper {x y w word wordType} { - global editors lexers variables - variable txt - variable win - # set txt $w.frmText.t - # блокировка открытия диалога если запущен другой - set txt $w - # set win .varhelper - # Проверяем если есть выделение то блокировать появление диалога - if {[$txt tag ranges sel] != ""} { - DebugPuts "You have selected text [$txt tag ranges sel]" - return - } - # puts "$x $y $w $word $wordType" - set fileType [dict get $editors $txt fileType] - - if {[dict exists $editors $txt variableList] != 0} { - set varList [dict get $editors $txt variableList] - # puts $varList - } - if {[dict exists $editors $txt procedureList] != 0} { - set procList [dict get $editors $txt procedureList] - } - # puts $procList - # puts ">>>>>>>[dict get $lexers $fileType commands]" - if {[dict exists $lexers $fileType commands] !=0} { - foreach i [dict get $lexers $fileType commands] { - # puts $i - lappend procList $i - } - } - - # if {[dict exists $editors $txt variableList] == 0 && [dict exists $editors $txt procedureList] == 0} { - # return - # } - set findedVars "" - switch -- $wordType { - vars { - foreach i [lsearch -nocase -all $varList $word*] { - # puts [lindex $varList $i] - set item [lindex [lindex $varList $i] 0] - # puts $item - if {[lsearch $findedVars $item] eq "-1"} { - lappend findedVars $item - # puts $item - } - } - } - procedure { - foreach i [lsearch -nocase -all $procList $word*] { - # puts [lindex $varList $i] - set item [lindex [lindex $procList $i] 0] - # puts $item - if {[lsearch $findedVars $item] eq "-1"} { - lappend findedVars $item - # puts $item - } - } - } - default { - foreach i [lsearch -nocase -all $varList $word*] { - # puts [lindex $varList $i] - set item [lindex [lindex $varList $i] 0] - # puts $item - if {[lsearch $findedVars $item] eq "-1"} { - lappend findedVars $item - # puts $item - } - } - foreach i [lsearch -nocase -all $procList $word*] { - # puts [lindex $varList $i] - set item [lindex [lindex $procList $i] 0] - # puts $item - if {[lsearch $findedVars $item] eq "-1"} { - lappend findedVars $item - # puts $item - } - } - } - } - # unset item - # bindtags $txt [list VarHelperBind [winfo toplevel $txt] $txt Ctext sysAfter all] - # bindtags $txt.t [list VarHelperBind [winfo parent $txt.t] $txt.t Text sysAfter all] - # bind VarHelperBind "Editor::VarHelperEscape $txt.t; break" - # # bindtags $txt.t {[list [winfo parent $txt.t] $txt.t Text sysAfter all]}; - # # bindtags $txt {[list [winfo toplevel $txt] $txt Ctext sysAfter all]}; - # # catch { destroy .varhelper }" - # bind VarHelperBind {Editor::VarHelperKey %W %K %A; break} - # - if {$findedVars eq ""} { - return - } - # puts $findedVars - VarHelperDialog $x $y $w $word $findedVars - - } - - proc VarHelperDialog {x y w word findedVars} { - global editors lexers variables - variable txt - variable win - # puts ">>>>>>>>>>>>>$x $y $w $word $findedVars" - # set txt $w.frmText.t - # блокировка открытия диалога если запущен другой - # if [winfo exists .findVariables] { - # return - # } - # if { [winfo exists $win] } { destroy $win } - set txt $w - set win .varhelper - # if {$findedVars eq ""} { - # return - # } - toplevel $win - wm transient $win . - wm overrideredirect $win 1 - - listbox $win.lBox -width 30 -border 0 - pack $win.lBox -expand true -fill y -side left - - foreach { item } $findedVars { - $win.lBox insert end $item - } - - catch { $win.lBox activate 0 ; $win.lBox selection set 0 0 } - - if { [set height [llength $findedVars]] > 10 } { set height 10 } - $win.lBox configure -height $height - - # focus $win.lBox - - bind $win { - destroy $Editor::win - focus -force $Editor::txt.t - break - } - bind $win.lBox { - destroy $Editor::win - focus -force $Editor::txt.t - break - } - bind VarHelperBind { - $Editor::txt delete "insert - 1 chars wordstart" "insert wordend - 1 chars" - $Editor::txt insert "insert" [.varhelper.lBox get [.varhelper.lBox curselection]] - # eval [bind VarHelperBind ] - Editor::VarHelperEscape $Editor::txt - break - } - - # Определям расстояние до края экрана (основного окна) и если - # оно меньше размера окна со списком то сдвигаем его вверх - set winGeomY [winfo reqheight $win] - set winGeomX [winfo reqwidth $win] - - set topHeight [winfo height .] - set topWidth [winfo width .] - set topLeftUpperX [winfo x .] - set topLeftUpperY [winfo y .] - set topRightLowerX [expr $topLeftUpperX + $topWidth] - set topRightLowerY [expr $topLeftUpperY + $topHeight] - - if {[expr [expr $x + $winGeomX] > $topRightLowerX]} { - set x [expr $x - $winGeomX] - } - if {[expr [expr $y + $winGeomY] > $topRightLowerY]} { - set y [expr $y - $winGeomY] - } - - wm geom $win +$x+$y - } - proc ReleaseKey {k txt fileType} { global cfgVariables lexers set pos [$txt index insert] @@ -645,8 +418,53 @@ namespace eval Editor { unset lpos $txt tag remove lightSelected 1.0 end - if { [winfo exists .varhelper] } { destroy .varhelper } - # puts $k + # Обработка ввода для показа окна с подсказками. + # if { [winfo exists .varhelper] } { destroy .varhelper } + # Флаг, нужно ли показывать новый список + set showNewList 1 + + # Проверяем окно списка + if {[winfo exists .varhelper]} { + # Определяем, какая клавиша отпущена + switch -- $k { + Up - Down { + # Стрелки - управление списком, окно остается + # НЕ показываем новый список + set showNewList 0 + return + } + Return { + # Enter - выберет элемент, окно закроется в SelectFromList + # НЕ показываем новый список + set showNewList 0 + return + } + Escape { + # Escape - закрыть окно + destroy .varhelper + set ::Helper::listActive 0 + Helper::VarHelperBindingsRestore $txt + # НЕ показываем новый список + set showNewList 0 + return + } + Control_L - Control_R - Alt_L - Alt_R - Shift_L - Shift_R { + # Модификаторы - окно остается + # НЕ показываем новый список + set showNewList 0 + return + } + default { + # Любая другая клавиша (буквы, цифры, пробел, Tab и т.д.) + # закрывает окно списка, но ПОКАЗЫВАЕМ новый список + destroy .varhelper + set ::Helper::listActive 0 + Helper::VarHelperBindingsRestore $txt + # showNewList остается = 1 (показываем новый список) + } + } + } + switch $k { Return { regexp {^(\s*)} [$txt get [expr $lineNum - 1].0 [expr $lineNum - 1].end] -> spaceStart @@ -693,7 +511,7 @@ namespace eval Editor { set lastSymbol [string last $varSymbol [$txt get $lineNum.0 $pos]] if {$lastSymbol ne "-1"} { set word [string trim [$txt get $lineNum.[expr $lastSymbol + 1] $pos]] - Editor::VarHelper $box_x $box_y $txt $word vars + Helper::VarHelper $box_x $box_y $txt $word vars } } else { set ind [$txt search -backwards -regexp {\W} $pos {insert linestart}] @@ -706,7 +524,7 @@ namespace eval Editor { set word [$txt get {insert linestart} $pos] } if {$word ne ""} { - Editor::VarHelper $box_x $box_y $txt $word {} + Helper::VarHelper $box_x $box_y $txt $word {} } } } @@ -722,7 +540,7 @@ namespace eval Editor { set word [$txt get {insert linestart} $pos] } if {$word ne ""} { - Editor::VarHelper $box_x $box_y $txt $word procedure + Helper::VarHelper $box_x $box_y $txt $word procedure } } } diff --git a/lib/helper.tcl b/lib/helper.tcl new file mode 100644 index 0000000..8dd03e1 --- /dev/null +++ b/lib/helper.tcl @@ -0,0 +1,336 @@ +namespace eval Helper { + variable ::originalBindings {} + # Флаг, указывающий, что окно со списком активно + variable ::listActive 0 + # Переменная для отслеживания предыдущего ввода (чтобы не обновлять список без необходимости) + variable ::previousInput "" + + proc VarHelperKey { widget K A } { + set win .varhelper + DebugPuts "Helper::VarHelperKey: K=$K, A='$A'" + + # Проверяем, существует ли окно списка + if {![winfo exists $win]} { + DebugPuts "Window doesn't exist, restoring bindings" + Helper::VarHelperBindingsRestore $widget + set ::listActive 0 + return + } + + switch -- $K { + { + DebugPuts "Processing Up arrow" + # Перемещаем выбор вверх + set current [$win.lBox curselection] + DebugPuts "Current selection: $current" + + if {$current ne "" && $current > 0} { + $win.lBox selection clear 0 end + $win.lBox selection set [expr {$current - 1}] + $win.lBox activate [expr {$current - 1}] + $win.lBox see [expr {$current - 1}] + } elseif {[$win.lBox size] > 0} { + # Если ничего не выбрано, выбираем последний элемент + set last [expr {[$win.lBox size] - 1}] + $win.lBox selection clear 0 end + $win.lBox selection set $last + $win.lBox activate $last + $win.lBox see $last + } + return -code break + } + { + DebugPuts "Processing Down arrow" + # Перемещаем выбор вниз + set current [$win.lBox curselection] + set size [$win.lBox size] + DebugPuts "Current selection: $current, size: $size" + + if {$current ne "" && $current < $size - 1} { + $win.lBox selection clear 0 end + $win.lBox selection set [expr {$current + 1}] + $win.lBox activate [expr {$current + 1}] + $win.lBox see [expr {$current + 1}] + } elseif {$size > 0} { + # Если ничего не выбрано, выбираем первый элемент + $win.lBox selection clear 0 end + $win.lBox selection set 0 + $win.lBox activate 0 + $win.lBox see 0 + } + return -code break + } + { + DebugPuts "Processing Return" + Helper::SelectFromList $widget + return -code break + } + { + DebugPuts "Processing Escape" + # Закрываем окно списка + wm withdraw $win + set ::listActive 0 + Helper::VarHelperBindingsRestore $widget + set ::previousInput "" + focus $widget + return -code break + } + default { + DebugPuts "Default case for K=$K, A='$A'" + # Для печатных символов + if {$A ne ""} { + DebugPuts "Inserting character '$A' and restoring bindings" + # Восстанавливаем привязки перед вставкой + Helper::VarHelperBindingsRestore $widget + # Вставляем символ + $widget insert "insert" $A + } + return -code break + } + } + } + + proc VarHelper {x y w word wordType} { + global editors lexers variables + variable txt + variable win + + DebugPuts "=== VarHelper called: word='$word', wordType='$wordType' ===" + + set txt $w + # Проверяем если есть выделение то блокировать появление диалога + if {[$txt tag ranges sel] != ""} { + DebugPuts "You have selected text [$txt tag ranges sel]" + return + } + + set fileType [dict get $editors $txt fileType] + + if {[dict exists $editors $txt variableList] != 0} { + set varList [dict get $editors $txt variableList] + } else { + set varList {} + } + if {[dict exists $editors $txt procedureList] != 0} { + set procList [dict get $editors $txt procedureList] + } else { + set procList {} + } + + if {[dict exists $lexers $fileType commands] != 0} { + foreach i [dict get $lexers $fileType commands] { + lappend procList $i + } + } + + set findedVars "" + switch -- $wordType { + vars { + foreach i [lsearch -nocase -all $varList $word*] { + set item [lindex [lindex $varList $i] 0] + if {[lsearch $findedVars $item] eq "-1"} { + lappend findedVars $item + } + } + } + procedure { + foreach i [lsearch -nocase -all $procList $word*] { + set item [lindex [lindex $procList $i] 0] + if {[lsearch $findedVars $item] eq "-1"} { + lappend findedVars $item + } + } + } + default { + foreach i [lsearch -nocase -all $varList $word*] { + set item [lindex [lindex $varList $i] 0] + if {[lsearch $findedVars $item] eq "-1"} { + lappend findedVars $item + } + } + foreach i [lsearch -nocase -all $procList $word*] { + set item [lindex [lindex $procList $i] 0] + if {[lsearch $findedVars $item] eq "-1"} { + lappend findedVars $item + } + } + } + } + + DebugPuts "Found [llength $findedVars] items: $findedVars" + + if {$findedVars eq ""} { + DebugPuts "No items found, returning" + return + } + + VarHelperDialog $x $y $w $word $findedVars + } + + proc VarHelperDialog {x y w word findedVars} { + variable txt + variable win + + set txt $w + set win .varhelper + + DebugPuts "VarHelperDialog called with [llength $findedVars] items" + + # Если окно уже существует, уничтожаем его + if {[winfo exists $win]} { + DebugPuts "Window already exists, destroying it" + destroy $win + Helper::VarHelperBindingsRestore $txt + } + + toplevel $win + wm transient $win . + wm overrideredirect $win 1 + + listbox $win.lBox -width 30 -border 0 + pack $win.lBox -expand true -fill y -side left + + foreach item $findedVars { + $win.lBox insert end $item + } + + DebugPuts "Listbox created with [llength $findedVars] items" + + # Выбираем первый элемент + if {[llength $findedVars] > 0} { + $win.lBox selection set 0 + $win.lBox activate 0 + } + + if {[set height [llength $findedVars]] > 10} { + set height 10 + } + $win.lBox configure -height $height + + Helper::VarHelperBindingsSetup $w + + # Привязка для закрытия окна списка + bind $win [list apply {{win txt} { + set ::listActive 0 + Helper::VarHelperBindingsRestore $txt + set ::previousInput "" + }} $win $txt.t] + + # Определяем расстояние до края экрана (основного окна) и если + # оно меньше размера окна со списком то сдвигаем его вверх + set winGeomY [winfo reqheight $win] + set winGeomX [winfo reqwidth $win] + + set topHeight [winfo height .] + set topWidth [winfo width .] + set topLeftUpperX [winfo x .] + set topLeftUpperY [winfo y .] + set topRightLowerX [expr $topLeftUpperX + $topWidth] + set topRightLowerY [expr $topLeftUpperY + $topHeight] + + if {[expr $x + $winGeomX] > $topRightLowerX} { + set x [expr $x - $winGeomX] + } + if {[expr $y + $winGeomY] > $topRightLowerY} { + set y [expr $y - $winGeomY] + } + set ::listActive 1 + DebugPuts "Showing window at +$x+$y" + wm geom $win +$x+$y + } + + proc VarHelperBindingsSetup {txt} { + DebugPuts "Setting up bindings for $txt" + + # Сбрасываем сохраненные привязки + set ::originalBindings {} + + # Список событий для перехвата + set events { } + + # Сохраняем и заменяем привязки + foreach event $events { + # Получаем текущую привязку + set original [bind $txt $event] + DebugPuts " Saving binding for $event: '$original'" + + # Сохраняем оригинал + lappend ::originalBindings [list $event $original] + + # Устанавливаем новую привязку + bind $txt $event [list Helper::VarHelperKey $txt $event %A] + } + } + + # Восстановление оригинальных привязок + proc VarHelperBindingsRestore {txt} { + DebugPuts "Restoring bindings for $txt" + DebugPuts "Have [llength $::originalBindings] bindings to restore" + + if {![info exists ::originalBindings]} { + DebugPuts " No original bindings stored" + # Очищаем наши привязки + foreach event { } { + bind $txt $event {} + } + return + } + + # Восстанавливаем оригинальные привязки + foreach binding $::originalBindings { + set event [lindex $binding 0] + set command [lindex $binding 1] + DebugPuts " Restoring $event: '$command'" + + if {$command eq ""} { + bind $txt $event {} + } else { + bind $txt $event $command + } + } + + # Очищаем сохраненные привязки + set ::originalBindings {} + } + + proc SelectFromList {txt} { + set win .varhelper + + DebugPuts "SelectFromList called" + + if {![winfo exists $win]} { + DebugPuts "Window doesn't exist" + return + } + + # Получаем выбранный элемент + set selected [$win.lBox curselection] + DebugPuts "Selected index: $selected" + + if {$selected ne ""} { + set text [$win.lBox get $selected] + DebugPuts "Selected text: $text" + + # Вставляем выбранный текст в текстовое поле + $txt delete "insert - 1 chars wordstart" "insert wordend - 1 chars" + $txt insert "insert" $text + + # Закрываем окно списка + destroy $win + set ::listActive 0 + Helper::VarHelperBindingsRestore $txt + set ::previousInput "" + + # Возвращаем фокус + focus $txt.t + } + } + + proc DebugPuts {msg} { + puts "DEBUG: $msg" + } +} + + + + diff --git a/lib/imgviewer.tcl b/lib/imgviewer.tcl index 436cf66..6c143c1 100644 --- a/lib/imgviewer.tcl +++ b/lib/imgviewer.tcl @@ -19,7 +19,7 @@ proc ImageViewer {f w node} { #$w.scrwin setwidget $w.scrwin.f openImg $f $w.f.c $node } - + proc openImg {fn w node} { global im1 factor set im1 [image create photo -file $fn]