tkpkg revision 50479
155714Skris#!/usr/local/bin/wish -f 255714Skris#$FreeBSD: head/usr.sbin/pkg_install/tkpkg 50479 1999-08-28 01:35:59Z peter $ 355714Skris# 455714Skris#$Log: tkpkg,v $ 555714Skris#Revision 1.4 1997/02/22 16:09:13 peter 655714Skris#Revert $FreeBSD: head/usr.sbin/pkg_install/tkpkg 50479 1999-08-28 01:35:59Z peter $ to $Id$ 755714Skris# 859191Skris#Revision 1.3 1997/01/14 07:14:23 jkh 959191Skris#Make the long-awaited change from $FreeBSD: head/usr.sbin/pkg_install/tkpkg 50479 1999-08-28 01:35:59Z peter $ 1059191Skris# 1159191Skris#This will make a number of things easier in the future, as well as (finally!) 1259191Skris#avoiding the Id-smashing problem which has plagued developers for so long. 1359191Skris# 1459191Skris#Boy, I'm glad we're not using sup anymore. This update would have been 1559191Skris#insane otherwise. 1659191Skris# 1759191Skris#Revision 1.2 1994/12/06 00:51:21 jkh 1859191Skris#Many of John T. Kohl's patches from NetBSD. Thanks, John! 1959191Skris#Submitted by: jkohl 2059191Skris# 2159191Skris# Revision 1.1 1994/01/06 08:16:20 jkh 2259191Skris# Cleaning house. 2359191Skris# 2459191Skris# Revision 1.1 1993/09/04 17:06:09 jkh 2559191Skris# Added Rich's wish front-end. 2659191Skris# 2759191Skris# Revision 1.6 1993/09/03 23:37:22 rich 2859191Skris# warn user if no tar archives are found in the current directory. 2959191Skris# removed the revision string from the lower text frame. 3059191Skris# 3159191Skris# Revision 1.5 1993/09/03 15:48:04 rich 3259191Skris# glob for .tar.gz, .tar.z and .tar.Z looking for archives 3359191Skris# 3459191Skris# Revision 1.4 1993/08/28 15:53:59 rich 3559191Skris# added version and date info to lower text window. 3659191Skris# 3759191Skris# Revision 1.3 1993/08/28 15:47:12 rich 3859191Skris# filtered out ^Ls in pkg_* output. 3959191Skris# 4059191Skris# 4159191Skrisset pkgname "" 4259191Skriswm title . "Package Installation" 4359191Skris#-------------------------------------------------------------- 4459191Skris# The top level main window, consisting of a bar of buttons and a list 4559191Skris# of packages and a description of the current package. 4659191Skris#-------------------------------------------------------------- 4759191Skrisframe .menu -relief raised -borderwidth 1 4859191Skrisframe .frame -borderwidth 4 4959191Skris 5059191Skrisscrollbar .frame.scroll -relief sunken -command ".frame.list yview" 5159191Skrislistbox .frame.list -yscroll ".frame.scroll set" -relief sunken -setgrid 1 5259191Skrispack append .frame .frame.scroll {right filly} \ 5355714Skris .frame.list {left expand fill} 5455714Skris 5555714Skris# build the lower window shoing the complete description of a pacage 5655714Skrisframe .f -borderwidth 4 5755714Skristext .f.t -width 80 -height 20 -yscrollcommand ".f.s set" -relief sunken 5855714Skris 5955714Skris# Initially display instructions in this window. Erase the 6055714Skris# instructions and show the package description when the user clicks 6155714Skris# on a package. 6255714Skris# 6355714Skris.f.t insert end "Double click on a package above to see its 6455714Skriscomplete description here." 6555714Skrisscrollbar .f.s -relief sunken -command ".f.t yview" 6655714Skrispack append .f .f.s {right filly} .f.t {left expand fill} 6755714Skris 6855714Skrisbind .frame.list <Double-Button-1> \ 6955714Skris {foreach i [selection get] {do_description $i}} 7055714Skrispack append . .menu {top fill} \ 7155714Skris .f {bottom expand fill} \ 7255714Skris .frame {bottom expand fill} 7355714Skris 7455714Skris#---------------------------------------------------------------- 7555714Skris# Make menu bar: 7655714Skris#---------------------------------------------------------------- 7755714Skrisbutton .menu.inst -text "Install" \ 7855714Skris -command "apply_to_pkg \"pkg_add -v\"" 7955714Skrisbutton .menu.dein -text "Deinstall" \ 8055714Skris -command "apply_to_pkg \"pkg_delete -v\"" 8155714Skrisbutton .menu.installed -text "What is Installed?" \ 8255714Skris -command "list_pkgs \"pkg_info -I -a |tr ' ' ' '\"" 8355714Skrisbutton .menu.available -text "What can I install?" \ 8455714Skris -command "list_pkgs \"pkg_info -I -c [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}] |tr ' ' ' '\"" 8555714Skrisbutton .menu.cont -text "Contents?" \ 8655714Skris -command "apply_to_pkg \"pkg_info -d -v\"" 8755714Skrisbutton .menu.quit -text "Quit" -command "destroy ." 8855714Skrisbutton .menu.help -text "Help" -command "do_help" 8955714Skris 9055714Skrispack append .menu \ 9155714Skris .menu.inst left \ 9255714Skris .menu.dein left \ 9355714Skris .menu.installed left \ 9455714Skris .menu.available left \ 9555714Skris .menu.cont left \ 9655714Skris .menu.quit left \ 9755714Skris .menu.help right 9855714Skris#------------------------------------------------------- 9955714Skris# Display the package description. 10055714Skris#------------------------------------------------------- 10155714Skrisproc list_pkgs {s} { 10255714Skris set line "" 10355714Skris set f [eval "open {| sh -c \"$s\" } r"] 10455714Skris .frame.list delete 0 end 10555714Skris while {[gets $f line] > 0} { 10655714Skris .frame.list insert end $line 10755714Skris } 10855714Skris close $f 10955714Skris} 11055714Skris 111# display the list of available packages 112set archives [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}] 113if {$archives == ""} { 114 .frame.list delete 0 end 115 .frame.list insert end "Warning: no compressed tar archives files found." 116} else { 117 list_pkgs "pkg_info -I -c $archives |tr ' ' ' '" 118} 119 120#------------------------------------------------------- 121# Display the package description. 122#------------------------------------------------------- 123proc do_description {s} { 124 global pkgname 125 regexp {[^ ]*} $s filename 126 set pkgname $filename 127 .f.t delete 0.0 end 128 set cmd "pkg_info -d $filename |tr -d ''" 129 set f [eval "open {| csh -c \"$cmd\" } r"] 130 while {![eof $f]} { 131 .f.t insert end [read $f] 132 } 133} 134#------------------------------------------------------- 135# package install window. 136#------------------------------------------------------- 137proc do_help {{w .help}} { 138 catch {destroy $w} 139 toplevel $w 140 wm title $w "Help" 141 wm iconname $w "Help" 142 button $w.ok -text OK -command "destroy $w" 143 message $w.t -relief raised -bd 2 \ 144 -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." 145 pack append $w $w.ok {bottom fillx} $w.t {expand fill} 146} 147#------------------------------------------------------- 148# Apply a command to a package. 149#------------------------------------------------------- 150proc apply_to_pkg {s} { 151 apply_to_pkg_err $s "" 152} 153#------------------------------------------------------- 154# Apply a command to a package, with error stream redirection instructions. 155#------------------------------------------------------- 156proc apply_to_pkg_err {s errredir} { 157 global pkgname 158 .f.t delete 0.0 end 159 if {$pkgname == ""} { 160 .f.t insert end "You must double click on a package name first!" 161 } else { 162 apply_to_pkg_int "$s $pkgname" "2>&1" 163 } 164} 165proc apply_to_pkg_int {s errredir} { 166 .f.t delete 0.0 end 167 .f.t insert end "Running: $s\n" 168 set f [eval "open {| sh -c \"$s $errredir\" } r"] 169 while {![eof $f]} { 170 .f.t insert end [read $f 64] 171 } 172} 173#------------------------------------------------------- 174# Invoke an arbitrary command. 175#------------------------------------------------------- 176proc do_command {s} { 177 .f.t delete 0.0 end 178 .f.t insert end "Running: $s\n" 179 set f [eval "open {| $s} r"] 180 while {![eof $f]} { 181 .f.t insert end [read $f 64] 182 } 183} 184# local variables: 185# mode: csh 186# compile-command: "" 187# comment-start: "# " 188# comment-start-skip: "# " 189# end: 190