#!/usr/local/bin/wish -f # from FreeBSD Id: tkpkg,v 1.4 1997/02/22 16:09:13 peter Exp # #$Log: tkpkg,v $ #Revision 1.2 1997/06/05 12:59:20 agc #Add NetBSD Ids #Un-munge pkg_install/lib/Makefile which I'd overwritten on libftpio commit. #Make it compile on NetBSD. #Install pkg_* programs in /usr/sbin # #XXX agc - Still to do XXX #Cleanup call to mktemp (for a tmp dir) in pkg_install/lib/pen.c #Create ftperr.c in the correct directory. # #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 \ {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: