#use lindex_resolve to support for example: ledit lst end+1 end+1 h i
set fidx [lindex_resolve [llength $l] $first]
switch -exact -- $fidx {
-3 {
#index below lower bound
set pre [list]
set fidx -1
}
-2 {
#first index position is greater than index of last element in the list
set pre [lrange $l 0 end]
set fidx [llength $l]
}
default {
set pre [lrange $l 0 $first-1]
}
}
set lidx [lindex_resolve [llength $l] $last]
switch -exact -- $lidx {
-3 {
#index below lower bound
set post [lrange $l 0 end]
}
-2 {
#index above upper bound
set post [list]
}
default {
if {$lidx < $fidx} {
#from ledit man page:
#If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted.
set post [lrange $l $fidx end]
} else {
set post [lrange $l $last+1 end]
}
}
}
set l [list {*}$pre {*}$args {*}$post]
}
#maint: taken from punk::lib
proc lindex_resolve {len index} {
if {![string is integer -strict $len]} {
#<0 ?
error "lindex_resolve len must be an integer"
}
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000
if {[string is integer -strict $index]} {
#can match +i -i
if {$index < 0} {
return -3
} elseif {$index >= $len} {
return -2
} else {
#integer may still have + sign - normalize with expr
return [expr {$index}]
}
} else {
if {[string match end* $index]} {
if {$index ne "end"} {
set op [string index $index 3]
set offset [string range $index 4 end]
if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"}
if {$op eq "+" && $offset != 0} {
return -2
}
} else {
#index is 'end'
set index [expr {$len-1}]
if {$index < 0} {
#special case - 'end' with empty list - treat end like a positive number out of bounds
return -2
} else {
return $index
}
}
if {$offset == 0} {
set index [expr {$len-1}]
if {$index < 0} {
return -2 ;#special case as above
} else {
return $index
}
} else {
#by now, if op = + then offset = 0 so we only need to handle the minus case
set index [expr {($len-1) - $offset}]
}
if {$index < 0} {
return -3
} else {
return $index
}
} else {
#plain +-<int> already handled above.
#we are trying to avoid evaluating unbraced expr of potentially insecure origin
if {[regexp {(.*)([+-])(.*)} $index _match a op b]} {
if {[string is integer -strict $a] && [string is integer -strict $b]} {
if {$op eq "-"} {
set index [expr {$a - $b}]
} else {
set index [expr {$a + $b}]
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
if {$index < 0} {
return -3
} elseif {$index >= $len} {
return -2
}
return $index
}
}
}
}
}
tcl::namespace::eval punk::libunknown::lib {
tcl::namespace::eval punk::libunknown::lib {
#A version of textutil::string::longestCommonPrefixList
#A version of textutil::string::longestCommonPrefixList
#use lindex_resolve to support for example: ledit lst end+1 end+1 h i
set fidx [lindex_resolve [llength $l] $first]
switch -exact -- $fidx {
-3 {
#index below lower bound
set pre [list]
set fidx -1
}
-2 {
#first index position is greater than index of last element in the list
set pre [lrange $l 0 end]
set fidx [llength $l]
}
default {
set pre [lrange $l 0 $first-1]
}
}
set lidx [lindex_resolve [llength $l] $last]
switch -exact -- $lidx {
-3 {
#index below lower bound
set post [lrange $l 0 end]
}
-2 {
#index above upper bound
set post [list]
}
default {
if {$lidx < $fidx} {
#from ledit man page:
#If last is less than first, then any specified elements will be inserted into the list before the element specified by first with no elements being deleted.
set post [lrange $l $fidx end]
} else {
set post [lrange $l $last+1 end]
}
}
}
set l [list {*}$pre {*}$args {*}$post]
}
#maint: taken from punk::lib
proc lindex_resolve {len index} {
if {![string is integer -strict $len]} {
#<0 ?
error "lindex_resolve len must be an integer"
}
set index [tcl::string::map {_ {}} $index] ;#forward compatibility with integers such as 1_000
if {[string is integer -strict $index]} {
#can match +i -i
if {$index < 0} {
return -3
} elseif {$index >= $len} {
return -2
} else {
#integer may still have + sign - normalize with expr
return [expr {$index}]
}
} else {
if {[string match end* $index]} {
if {$index ne "end"} {
set op [string index $index 3]
set offset [string range $index 4 end]
if {$op ni {+ -} || ![string is integer -strict $offset]} {error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"}
if {$op eq "+" && $offset != 0} {
return -2
}
} else {
#index is 'end'
set index [expr {$len-1}]
if {$index < 0} {
#special case - 'end' with empty list - treat end like a positive number out of bounds
return -2
} else {
return $index
}
}
if {$offset == 0} {
set index [expr {$len-1}]
if {$index < 0} {
return -2 ;#special case as above
} else {
return $index
}
} else {
#by now, if op = + then offset = 0 so we only need to handle the minus case
set index [expr {($len-1) - $offset}]
}
if {$index < 0} {
return -3
} else {
return $index
}
} else {
#plain +-<int> already handled above.
#we are trying to avoid evaluating unbraced expr of potentially insecure origin
if {[regexp {(.*)([+-])(.*)} $index _match a op b]} {
if {[string is integer -strict $a] && [string is integer -strict $b]} {
if {$op eq "-"} {
set index [expr {$a - $b}]
} else {
set index [expr {$a + $b}]
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
} else {
error "bad index '$index': must be integer?\[+-\]integer? or end?\[+-\]integer?"
}
if {$index < 0} {
return -3
} elseif {$index >= $len} {
return -2
}
return $index
}
}
}
}
}
tcl::namespace::eval punk::libunknown::lib {
tcl::namespace::eval punk::libunknown::lib {
#A version of textutil::string::longestCommonPrefixList
#A version of textutil::string::longestCommonPrefixList
