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