2
# This is a Tcl/Tk script to be interpreted by tclsh: \
5
# tclunindex.tcl --- removes reference to packages in a
6
# Tcl package index file, version 1.1
8
# assumes that each "package ifneeded" is in a single line
10
# Copyright (c) 2005 Miguel Filgueiras mig@ncc.up.pt Universidade do Porto
12
# This program is free software; you can redistribute it and/or modify
13
# it under the terms of the GNU General Public License as published by
14
# the Free Software Foundation; either version 2 of the License, or
15
# (at your option) any later version.
17
# This program is distributed in the hope that it will be useful,
18
# but WITHOUT ANY WARRANTY; without even the implied warranty of
19
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20
# GNU General Public License for more details.
22
# You should have received a copy of the GNU General Public License
23
# along with this program.
27
# last change: 3 October 2005
29
set Usage {Usage: tclunindex.tcl FILE PACKAGE [... PACKAGE]}
31
if { [llength $argv] < 2 } {
36
if { [catch {set file [open [set fname [lindex $argv 0]] r]}] || \
37
! [file writable $fname] } {
38
puts stderr "Cannot open file $fname"
42
proc NewTempFileName {} {
43
# return name for temporary file that does not clash with existing files
46
while { [glob -nocomplain tmp-$t] != "" } { incr t 123 }
50
set ntmp [NewTempFileName]
51
if { [catch {set tmp [open $ntmp w]}] } {
52
puts stderr "Cannot open temporary file"
56
set paks [lreplace $argv 0 0]
58
while { ! [eof $file] } {
62
{^[ \t]*package [ \t]*ifneeded [ \t]*([a-zA-Z_0-9]+) [ \t]*} \
64
if { [set i [lsearch -exact $paks $p]] != -1 } {
65
puts "Deleting line: $line"
66
set paks [lreplace $paks $i $i]
76
file rename -force -- $ntmp $fname
added
removed
tclunindex.tcl
