Добавил код из https://github.com/wandrien/projman/tree/master для работы с выделенным текстом. И внес изменения в связи с этим.
This commit is contained in:
Sergey Kalinin
302
lib/text_case.tcl
Normal file
302
lib/text_case.tcl
Normal file
@@ -0,0 +1,302 @@
|
||||
# Copyright 2026 Vadim Ushakov <wandrien.dev@gmail.com>
|
||||
|
||||
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 }
|
||||
Reference in New Issue
Block a user