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.3 2004/07/30 04:46:11 dillon Exp $
6 #Revision 1.2 1994/12/06 00:51:21 jkh
7 #Many of John T. Kohl's patches from NetBSD. Thanks, John!
10 # Revision 1.1 1994/01/06 08:16:20 jkh
13 # Revision 1.1 1993/09/04 17:06:09 jkh
14 # Added Rich's wish front-end.
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.
20 # Revision 1.5 1993/09/03 15:48:04 rich
21 # glob for .tar.gz, .tar.z and .tar.Z looking for archives
23 # Revision 1.4 1993/08/28 15:53:59 rich
24 # added version and date info to lower text window.
26 # Revision 1.3 1993/08/28 15:47:12 rich
27 # filtered out ^Ls in pkg_* output.
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
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}
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
48 # Initially display instructions in this window. Erase the
49 # instructions and show the package description when the user clicks
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}
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}
63 #----------------------------------------------------------------
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"
82 .menu.installed left \
83 .menu.available left \
87 #-------------------------------------------------------
88 # Display the package description.
89 #-------------------------------------------------------
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
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."
106 list_pkgs "pkg_info -I -c $archives |tr ' ' ' '"
109 #-------------------------------------------------------
110 # Display the package description.
111 #-------------------------------------------------------
112 proc do_description {s} {
114 regexp {[^ ]*} $s filename
115 set pkgname $filename
117 set cmd "pkg_info -d $filename |tr -d '
\f'"
118 set f [eval "open {| csh -c \"$cmd\" } r"]
120 .f.t insert end [read $f]
123 #-------------------------------------------------------
124 # package install window.
125 #-------------------------------------------------------
126 proc do_help {{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}
136 #-------------------------------------------------------
137 # Apply a command to a package.
138 #-------------------------------------------------------
139 proc apply_to_pkg {s} {
140 apply_to_pkg_err $s ""
142 #-------------------------------------------------------
143 # Apply a command to a package, with error stream redirection instructions.
144 #-------------------------------------------------------
145 proc apply_to_pkg_err {s errredir} {
148 if {$pkgname == ""} {
149 .f.t insert end "You must double click on a package name first!"
151 apply_to_pkg_int "$s $pkgname" "2>&1"
154 proc apply_to_pkg_int {s errredir} {
156 .f.t insert end "Running: $s\n"
157 set f [eval "open {| sh -c \"$s $errredir\" } r"]
159 .f.t insert end [read $f 64]
162 #-------------------------------------------------------
163 # Invoke an arbitrary command.
164 #-------------------------------------------------------
165 proc do_command {s} {
167 .f.t insert end "Running: $s\n"
168 set f [eval "open {| $s} r"]
170 .f.t insert end [read $f 64]
175 # compile-command: ""
176 # comment-start: "# "
177 # comment-start-skip: "# "