diff --git a/lib/editor.tcl b/lib/editor.tcl index 1be5bf2..5f35c60 100644 --- a/lib/editor.tcl +++ b/lib/editor.tcl @@ -746,6 +746,18 @@ namespace eval Editor { } bind $txt "Editor::SplitEditorForExecute $w $fileType $nb " bind $txt "Editor::SplitEditorForExecute $w $fileType $nb " + + bind $txt {SelectionToUpperCase %W} + bind $txt {SelectionToUpperCase %W} + bind $txt {SelectionToLowerCase %W} + bind $txt {SelectionToLowerCase %W} + bind $txt {SelectionToTitleCase %W} + bind $txt {SelectionToTitleCase %W} + bind $txt {SelectionToSentenceCase %W} + bind $txt {SelectionToSentenceCase %W} + bind $txt {SelectionToggleCase %W} + bind $txt {SelectionToggleCase %W} + # bind $txt FileOper::Close # bind $txt "FileOper::Close saveas" diff --git a/lib/gui.tcl b/lib/gui.tcl index 6e0351e..ff0a3af 100644 --- a/lib/gui.tcl +++ b/lib/gui.tcl @@ -236,7 +236,7 @@ ttk::style layout TNotebook.Tab { } } bind TNotebook "catch {NB::PressTab %W %x %y}\;[bind TNotebook ];break" -# bind <> "NB::PressTab %W %x %y" +bind <> "catch {NB::PressTab %W %x %y}\;[bind TNotebook ];break" # bind TNotebook "NB::PressTab %W %x %y" # bind TNotebook FileOper::Close # bind . "NB::NextTab $nbEditor" diff --git a/lib/menu.tcl b/lib/menu.tcl index 4526087..e837fb6 100644 --- a/lib/menu.tcl +++ b/lib/menu.tcl @@ -69,6 +69,15 @@ proc GetEditMenu {m} { -accelerator "Ctrl+F" # $m add command -label [::msgcat::mc "Replace"] -command Replace\ # -accelerator "Ctrl+R" + + $m add separator + menu $m.convertCase + $m add cascade -label [::msgcat::mc "Convert case"] -menu $m.convertCase + GetConvertCaseMenu $m.convertCase + menu $m.convertNamingStyle + $m add cascade -label [::msgcat::mc "Convert naming style"] -menu $m.convertNamingStyle + GetConvertIdentCaseMenu $m.convertNamingStyle + $m add separator $m add command -label [::msgcat::mc "Find in files"] -command "FileOper::FindInFiles"\ -accelerator "Ctrl+Shift+F" @@ -138,3 +147,47 @@ proc GetHelpMenu {m} { proc PopupMenu {x y} { tk_popup .popup $x $y } + +# ============================================================ +# 2026 Vadim Ushakov +proc GetConvertCaseMenu {m} { + $m add command -label [::msgcat::mc "UPPER CASE"] -command SelectionToUpperCase\ + -accelerator "Ctrl+Shift+U" + $m add command -label [::msgcat::mc "lower case"] -command SelectionToLowerCase\ + -accelerator "Ctrl+Shift+L" + $m add command -label [::msgcat::mc "Title Case"] -command SelectionToTitleCase\ + -accelerator "Ctrl+Shift+T" + $m add command -label [::msgcat::mc "Sentence case"] -command SelectionToSentenceCase\ + -accelerator "Ctrl+Shift+Y" + $m add command -label [::msgcat::mc "iNVERT CASE"] -command SelectionToggleCase\ + -accelerator "Ctrl+Shift+I" +} +proc GetConvertIdentCaseMenu {m} { + $m add command -label [::msgcat::mc "flatcase"] -command SelectionToFlatCase + $m add command -label [::msgcat::mc "UPPERCASE"] -command SelectionToUpperFlatCase + + $m add separator + + $m add command -label [::msgcat::mc "camelCase"] -command SelectionToCamelCase + $m add command -label [::msgcat::mc "PascalCase"] -command SelectionToPascalCase + + $m add separator + + $m add command -label [::msgcat::mc "snake_case"] -command SelectionToSnakeCase + $m add command -label [::msgcat::mc "SCREAMING_SNAKE_CASE"] -command SelectionToScreamingSnakeCase + $m add command -label [::msgcat::mc "camel_Snake_Case"] -command SelectionToCamelSnakeCase + $m add command -label [::msgcat::mc "Title_Case"] -command SelectionToTitleSnakeCase + + $m add separator + + $m add command -label [::msgcat::mc "kebab-case"] -command SelectionToKebabCase + $m add command -label [::msgcat::mc "SCREAMING-KEBAB-CASE"] -command SelectionToScreamingKebabCase + $m add command -label [::msgcat::mc "Train-Case"] -command SelectionToTrainCase + + $m add separator + + $m add command -label [::msgcat::mc "space separated"] -command SelectionToWords +} +# 2026 Vadim Ushakov +# ============================================================ + diff --git a/lib/msgs/en.msg b/lib/msgs/en.msg index 72cadfe..31a6a59 100644 --- a/lib/msgs/en.msg +++ b/lib/msgs/en.msg @@ -185,4 +185,23 @@ ::msgcat::mcset en "Word wrapping" ::msgcat::mcset en "Work dir" +::msgcat::mcset en "Convert case" +::msgcat::mcset en "Convert naming style" +::msgcat::mcset en "UPPER CASE" +::msgcat::mcset en "lower case" +::msgcat::mcset en "Title Case" +::msgcat::mcset en "Sentence case" +::msgcat::mcset en "iNVERT CASE" +::msgcat::mcset en "flatcase" +::msgcat::mcset en "UPPERCASE" +::msgcat::mcset en "camelCase" +::msgcat::mcset en "PascalCase" +::msgcat::mcset en "snake_case" +::msgcat::mcset en "SCREAMING_SNAKE_CASE" +::msgcat::mcset en "camel_Snake_Case" +::msgcat::mcset en "Title_Case" +::msgcat::mcset en "kebab-case" +::msgcat::mcset en "SCREAMING-KEBAB-CASE" +::msgcat::mcset en "Train-Case" +::msgcat::mcset en "space separated" diff --git a/lib/msgs/ru.msg b/lib/msgs/ru.msg index 0991f34..664cfda 100644 --- a/lib/msgs/ru.msg +++ b/lib/msgs/ru.msg @@ -234,3 +234,24 @@ ::msgcat::mcset ru "Editors word wrapping" "Перенос слов в редакторе" ::msgcat::mcset ru "Work dir" "Рабочий каталог" ::msgcat::mcset ru "Yes" "Да" + +::msgcat::mcset ru "Convert case" "Изменить регистр" +::msgcat::mcset ru "Convert naming style" "Изменить стиль написания" +::msgcat::mcset ru "UPPER CASE" "ЗАГЛАВНЫЕ БУКВЫ" +::msgcat::mcset ru "lower case" "строчные буквы" +::msgcat::mcset ru "Title Case" "Заглавные Буквы" +::msgcat::mcset ru "Sentence case" "Предложение с заглавной" +::msgcat::mcset ru "iNVERT CASE" "иНВЕРТИРОВАННЫЙ РЕГИСТР" +::msgcat::mcset ru "flatcase" "плоскийтекст" +::msgcat::mcset ru "UPPERCASE" "ЗАГЛАВНЫМИБУКВАМИ" +::msgcat::mcset ru "camelCase" "верблюжийСтиль" +::msgcat::mcset ru "PascalCase" "ВерхнийВерблюжийСтиль" +::msgcat::mcset ru "snake_case" "змеиный_стиль" +::msgcat::mcset ru "SCREAMING_SNAKE_CASE" "ЗАГЛАВНЫМИ_БУКВАМИ" +::msgcat::mcset ru "camel_Snake_Case" "верблюжий_Змеиный" +::msgcat::mcset ru "Title_Case" "Заглавный_С_Подчеркиванием" +::msgcat::mcset ru "kebab-case" "два-слова" +::msgcat::mcset ru "SCREAMING-KEBAB-CASE" "ДВА-СЛОВА" +::msgcat::mcset ru "Train-Case" "Два-Слова" +::msgcat::mcset ru "space separated" "разделить пробелом" + diff --git a/lib/procedure.tcl b/lib/procedure.tcl index d34f814..3ae2fee 100644 --- a/lib/procedure.tcl +++ b/lib/procedure.tcl @@ -1135,18 +1135,74 @@ proc ExecutorCommandPathSetting {fileType} { } } -# ----------- -# Thanks https://github.com/wandrien/ +# ===================================================================== +# 2026 Vadim Ushakov # https://github.com/wandrien/projman/commit/22f6e235c3532c20573d44ee7eaaaa1fb56ad544 -proc SendEventToLatestTxtWidget {ev} { +proc ReplaceSelection {w newText} { + set selStart [$w index sel.first] + + # Сохраняем и отключаем auto-separators + set autoSep [$w cget -autoseparators] + $w configure -autoseparators 0 + + # Замена текста как атомарный блок в Undo-стеке + $w edit separator + $w delete sel.first sel.last + $w insert $selStart $newText + $w edit separator + + # Восстанавливаем autoseparators + $w configure -autoseparators $autoSep + + # Восстанавливаем выделение на новом тексте + set selEnd [$w index "$selStart + [string length $newText] chars"] + $w tag add sel $selStart $selEnd + + # Если ctext поддерживает подсветку - обновляем её + catch {$w highlight $selStart $selEnd} +} + +proc HasSelection {w} { + set ranges [$w tag ranges sel] + return [expr {$ranges ne ""}] +} + +proc GetLatestTxtWidget {} { global latestTxtWidget if {$latestTxtWidget eq ""} { - return + # pass } elseif {[winfo exists $latestTxtWidget] && [winfo class $latestTxtWidget] eq "Ctext"} { - event generate ${latestTxtWidget}.t $ev + # pass } else { set latestTxtWidget "" } + return $latestTxtWidget +} + +proc ChoiceTxtWidgetOrLatest {{w ""}} { + if {$w ne ""} { + return $w + } + return [GetLatestTxtWidget] +} + +proc ProcessSelection {handle {w ""}} { + set w [ChoiceTxtWidgetOrLatest $w] + if {$w eq ""} { + return + } + if {![HasSelection $w]} { + return + } + set text [$w get sel.first sel.last] + ReplaceSelection $w [$handle $text] +} + +proc SendEventToLatestTxtWidget {ev} { + set w [GetLatestTxtWidget] + if {$w ne ""} { + event generate $w.t $ev + } } proc Cut {} { SendEventToLatestTxtWidget <> } @@ -1154,7 +1210,8 @@ proc Copy {} { SendEventToLatestTxtWidget <> } proc Paste {} { SendEventToLatestTxtWidget <> } proc Undo {} { SendEventToLatestTxtWidget <> } proc Redo {} { SendEventToLatestTxtWidget <> } -# ------------ +# 2026 Vadim Ushakov +# ===================================================================== proc DebugPuts {msg} { global cfgVariables diff --git a/lib/text_case.tcl b/lib/text_case.tcl new file mode 100644 index 0000000..38c22d9 --- /dev/null +++ b/lib/text_case.tcl @@ -0,0 +1,302 @@ +# Copyright 2026 Vadim Ushakov + +proc SelectionToUpperCase {{w ""}} { + ProcessSelection TextToUpperCase $w +} + +proc SelectionToLowerCase {{w ""}} { + ProcessSelection TextToLowerCase $w +} + +proc SelectionToTitleCase {{w ""}} { + ProcessSelection TextToTitleCase $w +} + +proc SelectionToggleCase {{w ""}} { + ProcessSelection TextToggleCase $w +} + +proc SelectionToSentenceCase {{w ""}} { + ProcessSelection TextToSentenceCase $w +} + +################################################################################ + +proc TextToUpperCase {text} { + return [string toupper $text] +} + +proc TextToLowerCase {text} { + return [string tolower $text] +} + +proc TextToTitleCase {text} { + set result "" + set wordStart 1 + + foreach char [split $text ""] { + if {[string is alpha $char]} { + if {$wordStart} { + append result [string toupper $char] + set wordStart 0 + } else { + append result [string tolower $char] + } + } else { + append result $char + if {[string is space $char] || $char in {- _ . , ; : ! ? ( ) [ ]}} { + set wordStart 1 + } + } + } + + return $result +} + +proc TextToSentenceCase {text} { + set text [TextToLowerCase $text] + set result "" + set sentenceStart 1 + set afterPunctuation 0 + + foreach char [split $text ""] { + if {[string is alpha $char]} { + if {$sentenceStart} { + append result [TextToUpperCase $char] + set sentenceStart 0 + } else { + append result $char + } + set afterPunctuation 0 + } elseif {$char in {. ! ?}} { + append result $char + set afterPunctuation 1 + } elseif {[string is space $char]} { + append result $char + if {$afterPunctuation} { + set sentenceStart 1 + } + } else { + append result $char + set afterPunctuation 0 + } + } + + return $result +} + +proc TextToggleCase {text} { + set result "" + + foreach char [split $text ""] { + if {[string is upper $char]} { + append result [TextToLowerCase $char] + } elseif {[string is lower $char]} { + append result [TextToUpperCase $char] + } else { + append result $char + } + } + + return $result +} + +################################################################################ +# Identifier case conversion +################################################################################ + +proc IsIdentSeparator {char} { + expr {$char eq "_" || $char eq "-" || [string is space $char]} +} +proc IsUpperChar {c} { string is upper -strict $c } +proc IsLowerChar {c} { string is lower -strict $c } +proc IsAlphaChar {c} { string is alpha -strict $c } +proc IsDigitChar {c} { string is digit -strict $c } + +# Граница внутри "слитного" идентификатора (camel/pascal/акронимы/цифры): +# - lower -> Upper : twoWords +# - digit <-> alpha : word2Word, word2, 2word +# - "HTTPServer" : HTTP | Server (между P и S, т.к. S Upper и дальше lower) +proc IdentHasBoundary {prev cur next} { + set prevLower [IsLowerChar $prev] + set prevUpper [IsUpperChar $prev] + set prevAlpha [IsAlphaChar $prev] + set prevDigit [IsDigitChar $prev] + + set curUpper [IsUpperChar $cur] + set curAlpha [IsAlphaChar $cur] + set curDigit [IsDigitChar $cur] + + set nextLower 0 + if {$next ne ""} { + set nextLower [IsLowerChar $next] + } + + if {$prevLower && $curUpper} { + return 1 + } + if {($prevAlpha && $curDigit) || ($prevDigit && $curAlpha)} { + return 1 + } + if {$prevUpper && $curUpper && $nextLower} { + return 1 + } + return 0 +} + +# Главная стадия №1: распознать границы частей и вернуть список частей. +proc IdentSplit {text} { + set parts {} + set token "" + + set len [string length $text] + for {set i 0} {$i < $len} {incr i} { + set c [string index $text $i] + + if {[IsIdentSeparator $c]} { + if {$token ne ""} { + lappend parts $token + set token "" + } + continue + } + + if {$token ne ""} { + set prev [string index $text [expr {$i-1}]] + if {$i+1 < $len} { + set next [string index $text [expr {$i+1}]] + } else { + set next "" + } + + if {[IdentHasBoundary $prev $c $next]} { + lappend parts $token + set token "" + } + } + + append token $c + } + + if {$token ne ""} { + lappend parts $token + } + + return $parts +} + +# Применение капитализации к одной части +proc IdentPartLower {p} { string tolower $p } +proc IdentPartUpper {p} { string toupper $p } +proc IdentPartTitle {p} { + if {$p eq ""} { return "" } + set p [string tolower $p] + set first [string index $p 0] + set rest [string range $p 1 end] + return "[string toupper $first]$rest" +} + +proc IdentJoinAll {parts sep how} { + set out "" + set first 1 + foreach p $parts { + if {!$first} { append out $sep } else { set first 0 } + switch -- $how { + lower { append out [IdentPartLower $p] } + upper { append out [IdentPartUpper $p] } + title { append out [IdentPartTitle $p] } + default { error "Unknown case '$how'" } + } + } + return $out +} + +proc IdentJoinFirstRest {parts sep firstHow restHow} { + if {[llength $parts] == 0} { return "" } + + set out "" + set i 0 + foreach p $parts { + if {$i > 0} { append out $sep } + if {$i == 0} { + set how $firstHow + } else { + set how $restHow + } + switch -- $how { + lower { append out [IdentPartLower $p] } + upper { append out [IdentPartUpper $p] } + title { append out [IdentPartTitle $p] } + default { error "Unknown case '$how'" } + } + incr i + } + return $out +} + +################################################################################ +# Stage №2: parts -> target representation +################################################################################ + +proc IdentToFlatCase {text} { + return [IdentJoinAll [IdentSplit $text] "" lower] ;# twowords / flatcase +} + +proc IdentToUpperFlatCase {text} { + return [IdentJoinAll [IdentSplit $text] "" upper] ;# TWOWORDS / UPPERCASE +} + +proc IdentToCamelCase {text} { + return [IdentJoinFirstRest [IdentSplit $text] "" lower title] ;# twoWords +} + +proc IdentToPascalCase {text} { + return [IdentJoinAll [IdentSplit $text] "" title] ;# TwoWords +} + +proc IdentToSnakeCase {text} { + return [IdentJoinAll [IdentSplit $text] "_" lower] ;# two_words +} + +proc IdentToScreamingSnakeCase {text} { + return [IdentJoinAll [IdentSplit $text] "_" upper] ;# TWO_WORDS +} + +proc IdentToCamelSnakeCase {text} { + return [IdentJoinFirstRest [IdentSplit $text] "_" lower title] ;# two_Words +} + +proc IdentToTitleSnakeCase {text} { + return [IdentJoinAll [IdentSplit $text] "_" title] ;# Two_Words (Title_Case) +} + +proc IdentToKebabCase {text} { + return [IdentJoinAll [IdentSplit $text] "-" lower] ;# two-words +} + +proc IdentToScreamingKebabCase {text} { + return [IdentJoinAll [IdentSplit $text] "-" upper] ;# TWO-WORDS +} + +proc IdentToTrainCase {text} { + return [IdentJoinAll [IdentSplit $text] "-" title] ;# Two-Words +} + +proc IdentToWords {text} { + return [IdentJoinAll [IdentSplit $text] " " lower] ;# two words (space separated) +} + +################################################################################ + +proc SelectionToFlatCase {{w ""}} { ProcessSelection IdentToFlatCase $w } +proc SelectionToUpperFlatCase {{w ""}} { ProcessSelection IdentToUpperFlatCase $w } +proc SelectionToCamelCase {{w ""}} { ProcessSelection IdentToCamelCase $w } +proc SelectionToPascalCase {{w ""}} { ProcessSelection IdentToPascalCase $w } +proc SelectionToSnakeCase {{w ""}} { ProcessSelection IdentToSnakeCase $w } +proc SelectionToScreamingSnakeCase {{w ""}} { ProcessSelection IdentToScreamingSnakeCase $w } +proc SelectionToCamelSnakeCase {{w ""}} { ProcessSelection IdentToCamelSnakeCase $w } +proc SelectionToTitleSnakeCase {{w ""}} { ProcessSelection IdentToTitleSnakeCase $w } +proc SelectionToKebabCase {{w ""}} { ProcessSelection IdentToKebabCase $w } +proc SelectionToScreamingKebabCase {{w ""}} { ProcessSelection IdentToScreamingKebabCase $w } +proc SelectionToTrainCase {{w ""}} { ProcessSelection IdentToTrainCase $w } +proc SelectionToWords {{w ""}} { ProcessSelection IdentToWords $w } diff --git a/projman.tcl b/projman.tcl index b0442ed..b7148ff 100755 --- a/projman.tcl +++ b/projman.tcl @@ -9,7 +9,7 @@ exec wish8.6 "$0" -- "$@" # Home page: https://nuk-svk.ru ###################################################### # Version: 2.0.0 -# Release: beta4 +# Release: beta5 # Build: 13022026112625 ######################################################