usr.sbin/pkg_install/tkpkg

   1 #!/usr/local/bin/wish -f
   2 #$FreeBSD: src/usr.sbin/pkg_install/tkpkg,v 1.7 1999/08/29 15:54:49 peter Exp $
   3 #$DragonFly: src/usr.sbin/pkg_install/Attic/tkpkg,v 1.2 2003/06/17 04:29:59 dillon Exp $
   4 #
   5 #$Log: tkpkg,v $
   6 #Revision 1.2  1994/12/06 00:51:21  jkh
   7 #Many of John T. Kohl's patches from NetBSD.  Thanks, John!
   8 #Submitted by:  jkohl
   9 #
  10 # Revision 1.1  1994/01/06  08:16:20  jkh
  11 # Cleaning house.
  12 #
  13 # Revision 1.1  1993/09/04  17:06:09  jkh
  14 # Added Rich's wish front-end.
  15 #
  16 # Revision 1.6  1993/09/03  23:37:22  rich
  17 # warn user if no tar archives are found in the current directory.
  18 # removed the revision string from the lower text frame.
  19 #
  20 # Revision 1.5  1993/09/03  15:48:04  rich
  21 # glob for .tar.gz, .tar.z and .tar.Z looking for archives
  22 #
  23 # Revision 1.4  1993/08/28  15:53:59  rich
  24 # added version and date info to lower text window.
  25 #
  26 # Revision 1.3  1993/08/28  15:47:12  rich
  27 # filtered out ^Ls in pkg_* output.
  28 #
  29 #
  30 set pkgname ""
  31 wm title . "Package Installation"
  32 #--------------------------------------------------------------
  33 # The top level main window, consisting of a bar of buttons and a list
  34 # of packages and a description of the current package.
  35 #--------------------------------------------------------------
  36 frame .menu -relief raised -borderwidth 1
  37 frame .frame -borderwidth 4
  38
  39 scrollbar .frame.scroll -relief sunken -command ".frame.list yview"
  40 listbox .frame.list -yscroll ".frame.scroll set" -relief sunken -setgrid 1
  41 pack append .frame .frame.scroll {right filly} \
  42         .frame.list {left expand fill}
  43
  44 # build the lower window shoing the complete description of a pacage
  45 frame .f -borderwidth 4
  46 text .f.t -width 80 -height 20 -yscrollcommand ".f.s set" -relief sunken
  47
  48 # Initially display instructions in this window.  Erase the
  49 # instructions and show the package description when the user clicks
  50 # on a package.
  51 #
  52 .f.t insert end "Double click on a package above to see its
  53 complete description here."
  54 scrollbar .f.s -relief sunken -command ".f.t yview"
  55 pack append .f .f.s {right filly} .f.t {left expand fill}
  56
  57 bind .frame.list <Double-Button-1> \
  58     {foreach i [selection get] {do_description $i}}
  59 pack append .  .menu {top fill} \
  60    .f {bottom expand fill} \
  61    .frame {bottom expand fill}
  62
  63 #----------------------------------------------------------------
  64 # Make menu bar:
  65 #----------------------------------------------------------------
  66 button .menu.inst -text "Install" \
  67    -command "apply_to_pkg \"pkg_add -v\""
  68 button .menu.dein -text "Deinstall" \
  69    -command "apply_to_pkg \"pkg_delete -v\""
  70 button .menu.installed -text "What is Installed?" \
  71    -command "list_pkgs \"pkg_info -I -a |tr '   ' ' '\""
  72 button .menu.available -text "What can I install?" \
  73    -command "list_pkgs \"pkg_info -I -c [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}] |tr '     ' ' '\""
  74 button .menu.cont -text "Contents?" \
  75    -command "apply_to_pkg \"pkg_info -d -v\""
  76 button .menu.quit -text "Quit" -command "destroy ."
  77 button .menu.help -text "Help" -command "do_help"
  78
  79 pack append .menu \
  80   .menu.inst left \
  81   .menu.dein left \
  82   .menu.installed left \
  83   .menu.available left \
  84   .menu.cont left \
  85   .menu.quit left \
  86   .menu.help right
  87 #-------------------------------------------------------
  88 # Display the package description.
  89 #-------------------------------------------------------
  90 proc list_pkgs {s} {
  91   set line ""
  92   set f [eval "open {| sh -c \"$s\" } r"]
  93   .frame.list delete 0 end
  94   while {[gets $f line] > 0} {
  95     .frame.list insert end $line
  96   }
  97   close $f
  98 }
  99
 100 # display the list of available packages
 101 set archives [glob -nocomplain *.{tgz,tar.z,tar.gz,tar.Z}]
 102 if {$archives == ""} {
 103   .frame.list delete 0 end
 104  .frame.list insert end "Warning: no compressed tar archives files found."
 105 } else {
 106   list_pkgs "pkg_info -I -c $archives |tr '     ' ' '"
 107 }
 108
 109 #-------------------------------------------------------
 110 # Display the package description.
 111 #-------------------------------------------------------
 112 proc do_description {s} {
 113   global pkgname
 114   regexp {[^    ]*} $s filename
 115   set pkgname $filename
 116   .f.t delete 0.0 end
 117   set cmd "pkg_info -d $filename |tr -d '\f'"
 118   set f [eval "open {| csh -c \"$cmd\" } r"]
 119   while {![eof $f]} {
 120     .f.t insert end [read $f]
 121   }
 122 }
 123 #-------------------------------------------------------
 124 # package install window.
 125 #-------------------------------------------------------
 126 proc do_help {{w .help}} {
 127   catch {destroy $w}
 128   toplevel $w
 129   wm title $w "Help"
 130   wm iconname $w "Help"
 131   button $w.ok -text OK -command "destroy $w"
 132   message $w.t -relief raised -bd 2 \
 133     -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."
 134   pack append $w $w.ok {bottom fillx} $w.t {expand fill}
 135 }
 136 #-------------------------------------------------------
 137 # Apply a command to a package.
 138 #-------------------------------------------------------
 139 proc apply_to_pkg {s} {
 140     apply_to_pkg_err $s ""
 141 }
 142 #-------------------------------------------------------
 143 # Apply a command to a package, with error stream redirection instructions.
 144 #-------------------------------------------------------
 145 proc apply_to_pkg_err {s errredir} {
 146   global pkgname
 147   .f.t delete 0.0 end
 148   if {$pkgname == ""} {
 149     .f.t insert end "You must double click on a package name first!"
 150   } else {
 151     apply_to_pkg_int "$s $pkgname" "2>&1"
 152   }
 153 }
 154 proc apply_to_pkg_int {s errredir} {
 155     .f.t delete 0.0 end
 156     .f.t insert end "Running: $s\n"
 157     set f [eval "open {| sh -c \"$s $errredir\" } r"]
 158     while {![eof $f]} {
 159       .f.t insert end [read $f 64]
 160     }
 161 }
 162 #-------------------------------------------------------
 163 # Invoke an arbitrary command.
 164 #-------------------------------------------------------
 165 proc do_command {s} {
 166   .f.t delete 0.0 end
 167   .f.t insert end "Running: $s\n"
 168   set f [eval "open {| $s} r"]
 169   while {![eof $f]} {
 170     .f.t insert end [read $f 64]
 171   }
 172 }
 173 # local variables:
 174 # mode: csh
 175 # compile-command: ""
 176 # comment-start: "# "
 177 # comment-start-skip: "# "
 178 # end: