NetBSD/usr.sbin/pkg_install/tkpkg

193 lines
6.6 KiB
Plaintext
Raw Normal View History

#!/usr/local/bin/wish -f
# FreeBSD Id: tkpkg,v 1.4 1997/02/22 16:09:13 peter Exp
#
#$Log: tkpkg,v $
#Revision 1.1.1.1 1997/06/05 08:54:23 agc
#Initial import of FreeBSD packaging tool.
#
#Revision 1.4 1997/02/22 16:09:13 peter
#Revert -dollar-FreeBSD-dollar- to -dollar-Id-dollar- (changed from the obvious by agc)
#
#Revision 1.3 1997/01/14 07:14:23 jkh
#Make the long-awaited change from -dollar-Id: tkpkg,v 1.4 1997/02/22 16:09:13 peter Exp -dollar- to -dollar-Id: tkpkg,v 1.4 1997/02/22 16:09:13 peter Exp -dollar- (changed from the obvious by agc)
#
#This will make a number of things easier in the future, as well as (finally!)
#avoiding the Id-smashing problem which has plagued developers for so long.
#
#Boy, I'm glad we're not using sup anymore. This update would have been
#insane otherwise.
#
#Revision 1.2 1994/12/06 00:51:21 jkh
#Many of John T. Kohl's patches from NetBSD. Thanks, John!
#Submitted by: jkohl
#
# Revision 1.1 1994/01/06 08:16:20 jkh
# Cleaning house.
#
# Revision 1.1 1993/09/04 17:06:09 jkh
# Added Rich's wish front-end.
#
# Revision 1.6 1993/09/03 23:37:22 rich
# warn user if no tar archives are found in the current directory.
# removed the revision string from the lower text frame.
#
# Revision 1.5 1993/09/03 15:48:04 rich
# glob for .tar.gz, .tar.z and .tar.Z looking for archives
#
# Revision 1.4 1993/08/28 15:53:59 rich
# added version and date info to lower text window.
#
# Revision 1.3 1993/08/28 15:47:12 rich
# filtered out ^Ls in pkg_* output.
#
#
set pkgname ""
wm title . "Package Installation"
#--------------------------------------------------------------
# The top level main window, consisting of a bar of buttons and a list
# of packages and a description of the current package.
#--------------------------------------------------------------
frame .menu -relief raised -borderwidth 1
frame .frame -borderwidth 4
scrollbar .frame.scroll -relief sunken -command ".frame.list yview"
listbox .frame.list -yscroll ".frame.scroll set" -relief sunken -setgrid 1
pack append .frame .frame.scroll {right filly} \
.frame.list {left expand fill}
# build the lower window shoing the complete description of a pacage
frame .f -borderwidth 4
text .f.t -width 80 -height 20 -yscrollcommand ".f.s set" -relief sunken
# Initially display instructions in this window. Erase the
# instructions and show the package description when the user clicks
# on a package.
#
.f.t insert end "Double click on a package above to see its
complete description here."
scrollbar .f.s -relief sunken -command ".f.t yview"
pack append .f .f.s {right filly} .f.t {left expand fill}
bind .frame.list <Double-Button-1> \
{foreach i [selection get] {do_description $i}}
pack append . .menu {top fill} \
.f {bottom expand fill} \
.frame {bottom expand fill}
#----------------------------------------------------------------
# Make menu bar:
#----------------------------------------------------------------
button .menu.inst -text "Install" \
-command "apply_to_pkg \"pkg_add -v\""
button .menu.dein -text "Deinstall" \
-command "apply_to_pkg \"pkg_delete -v\""
button .menu.installed -text "What is Installed?" \
-command "list_pkgs \"pkg_info -I -a |tr ' ' ' '\""
button .menu.available -text "What can I install?" \
-command "list_pkgs \"pkg_info -I -c [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}] |tr ' ' ' '\""
button .menu.cont -text "Contents?" \
-command "apply_to_pkg \"pkg_info -d -v\""
button .menu.quit -text "Quit" -command "destroy ."
button .menu.help -text "Help" -command "do_help"
pack append .menu \
.menu.inst left \
.menu.dein left \
.menu.installed left \
.menu.available left \
.menu.cont left \
.menu.quit left \
.menu.help right
#-------------------------------------------------------
# Display the package description.
#-------------------------------------------------------
proc list_pkgs {s} {
set line ""
set f [eval "open {| sh -c \"$s\" } r"]
.frame.list delete 0 end
while {[gets $f line] > 0} {
.frame.list insert end $line
}
close $f
}
# display the list of available packages
set archives [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}]
if {$archives == ""} {
.frame.list delete 0 end
.frame.list insert end "Warning: no compressed tar archives files found."
} else {
list_pkgs "pkg_info -I -c $archives |tr ' ' ' '"
}
#-------------------------------------------------------
# Display the package description.
#-------------------------------------------------------
proc do_description {s} {
global pkgname
regexp {[^ ]*} $s filename
set pkgname $filename
.f.t delete 0.0 end
set cmd "pkg_info -d $filename |tr -d ' '"
set f [eval "open {| csh -c \"$cmd\" } r"]
while {![eof $f]} {
.f.t insert end [read $f]
}
}
#-------------------------------------------------------
# package install window.
#-------------------------------------------------------
proc do_help {{w .help}} {
catch {destroy $w}
toplevel $w
wm title $w "Help"
wm iconname $w "Help"
button $w.ok -text OK -command "destroy $w"
message $w.t -relief raised -bd 2 \
-text "You can install, deinstall and list info on the available packages. To select a package and see its complete description, press mouse button 1 over the package name. To install a selected package, press the Install button. To exit, press the \"Quit\" button."
pack append $w $w.ok {bottom fillx} $w.t {expand fill}
}
#-------------------------------------------------------
# Apply a command to a package.
#-------------------------------------------------------
proc apply_to_pkg {s} {
apply_to_pkg_err $s ""
}
#-------------------------------------------------------
# Apply a command to a package, with error stream redirection instructions.
#-------------------------------------------------------
proc apply_to_pkg_err {s errredir} {
global pkgname
.f.t delete 0.0 end
if {$pkgname == ""} {
.f.t insert end "You must double click on a package name first!"
} else {
apply_to_pkg_int "$s $pkgname" "2>&1"
}
}
proc apply_to_pkg_int {s errredir} {
.f.t delete 0.0 end
.f.t insert end "Running: $s\n"
set f [eval "open {| sh -c \"$s $errredir\" } r"]
while {![eof $f]} {
.f.t insert end [read $f 64]
}
}
#-------------------------------------------------------
# Invoke an arbitrary command.
#-------------------------------------------------------
proc do_command {s} {
.f.t delete 0.0 end
.f.t insert end "Running: $s\n"
set f [eval "open {| $s} r"]
while {![eof $f]} {
.f.t insert end [read $f 64]
}
}
# local variables:
# mode: csh
# compile-command: ""
# comment-start: "# "
# comment-start-skip: "# "
# end: