OpenCascade/occt
1
0
Fork 0
mirror of https://git.dev.opencascade.org/repos/occt.git synced 2025-04-04 18:06:22 +03:00
Code Packages Releases Activity

0028233: lvarpop is needed for correct work of lmatch defined in StandardCommands.tcl

Browse Source 
The proc lvarpop has been implemented.
This commit is contained in:
msv 2016-12-16 17:13:07 +03:00
parent 471b22dea3
commit ac0cdacd09
1 changed files with 29 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/DrawResources/StandardCommands.tcl
View File

@ -374,6 +374,35 @@ proc don { args } {
# available in extended Tcl (Tclx). # available in extended Tcl (Tclx).
# These procedures are added just to make full-working simulations of them. # These procedures are added just to make full-working simulations of them.
if {[info commands lvarpop] == ""} {
proc lvarpop args {
upvar [lindex $args 0] lvar
set index 0
set len [llength $lvar]
if {[llength $args] > 1} {
set ind [lindex $args 1]
if [regexp "^end" $ind] {
set index [expr $len-1]
} elseif [regexp "^len" $ind] {
set index $len
} else {set index $ind}
}
set el [lindex $lvar $index]
set newlvar {}
for {set i 0} {$i < $index} {incr i} {
lappend newlvar [lindex $lvar $i]
}
if {[llength $args] > 2} {
lappend newlvar [lindex $args 2]
}
for {set i [expr $index+1]} {$i < $len} {incr i} {
lappend newlvar [lindex $lvar $i]
}
set lvar $newlvar
return $el
}
}
if {[info commands lmatch] == ""} { if {[info commands lmatch] == ""} {
proc lmatch args { proc lmatch args {
set mode [switch -- [lindex $args 0] { set mode [switch -- [lindex $args 0] {