# # $RCSfile: auxil.itcl,v $ -- # # This file contains ... # # Copyright (c) 2004 Anton Kokalj Email: tone.kokalj@ijs.si # # # This file is distributed under the terms of the GNU General Public # License. See the file `COPYING' in the root directory of the present # distribution, or http://www.gnu.org/copyleft/gpl.txt . # # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS # OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL # ANTON KOKALJ BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN # AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN # CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # # $Id: auxil.itcl,v 1.1 2004-02-20 15:12:02 kokalj Exp $ # # ------------------------------------------------------------------------ # _uniqueTabname -- generates unique tabname # ------------------------------------------------------------------------ proc ::pwscf::_uniqueTabname {name} { variable tabNames if { ! [info exists tabNames] } { lappend tabNames $name return $name } else { if { [lsearch $tabNames $name] < 0 } { lappend tabNames $name return $name } else { # $name already exists; generate unique one set i 0 while { [lsearch $tabNames "$name (\#$i)"] >= 0 } { ::tclu::DEBUG _uniqueTabname: i=$i : [lsearch $tabNames "$name (\#$i)"] incr i } lappend tabNames "$name (\#$i)" return "$name (\#$i)" } } }