mirror of https://gitlab.com/QEF/q-e.git
51 lines
1.5 KiB
Plaintext
51 lines
1.5 KiB
Plaintext
#
|
|
# $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)"
|
|
}
|
|
}
|
|
}
|