annotate lisp/package-admin.el @ 318:afd57c14dfc8 r21-0b57

Import from CVS: tag r21-0b57
author cvs
date Mon, 13 Aug 2007 10:45:36 +0200
parents 341dac730539
children 19dcec799385
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
1 ;;; package-admin.el --- Installation and Maintenance of XEmacs packages
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
2
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
4
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
5 ;; Author: SL Baur <steve@altair.xemacs.org>
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
6 ;; Keywords: internal
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
7
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
8 ;; This file is part of XEmacs.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
9
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
10 ;; XEmacs is free software; you can redistribute it and/or modify it
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
11 ;; under the terms of the GNU General Public License as published by
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
13 ;; any later version.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
14
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
15 ;; XEmacs is distributed in the hope that it will be useful, but
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
18 ;; General Public License for more details.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
19
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
23 ;; 02111-1307, USA.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
24
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
25 ;;; Synched up with: Not in FSF
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
26
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
27 ;;; Commentary:
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
28
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
29 ;; First pass at lisp front end to package maintenance.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
30
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
31 ;;; Code:
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
32
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
33 (require 'config)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
34
237
89ec2bb86eea Import from CVS: tag r20-5b17
cvs
parents: 217
diff changeset
35 (defvar package-admin-xemacs (concat invocation-directory invocation-name)
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
36 "Location of XEmacs binary to use.")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
37
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
38 (defvar package-admin-temp-buffer "*Package Output*"
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
39 "Temporary buffer where output of backend commands is saved.")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
40
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
41 (defvar package-admin-install-function 'package-admin-default-install-function
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
42 "The function to call to install a package.
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
43 Three args are passed: FILENAME PKG-DIR BUF
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
44 Install package FILENAME into directory PKG-DIR, with any messages output
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
45 to buffer BUF.")
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
46
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
47 (defvar package-admin-error-messages '(
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
48 "No space left on device"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
49 "No such file or directory"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
50 "Filename too long"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
51 "Read-only file system"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
52 "File too large"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
53 "Too many open files"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
54 "Not enough space"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
55 "Permission denied"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
56 "Input/output error"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
57 "Out of memory"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
58 "Unable to create directory"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
59 "Directory checksum error"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
60 "Cannot exclusively open file"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
61 "corrupted file"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
62 "incomplete .* tree"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
63 "Bad table"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
64 "corrupt input"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
65 "invalid compressed data"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
66 "too many leaves in Huffman tree"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
67 "not a valid zip file"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
68 "first entry not deflated or stored"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
69 "encrypted file --"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
70 "unexpected end of file"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
71 )
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
72 "Regular expressions of possible error messages.
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
73 After each package extraction, the `package-admin-temp-buffer' buffer is
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
74 scanned for these messages. An error code is returned if one of these are
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
75 found.
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
76
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
77 This is awful, but it exists because error return codes aren't reliable
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
78 under MS Windows.")
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
79
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
80 (defvar package-admin-tar-filename-regexps
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
81 '(
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
82 ;; GNU tar:
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
83 ;; drwxrwxr-x john/doe 123 1997-02-18 15:48 pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
84 "\\S-+\\s-+[-a-z0-9_/]+\\s-+[0-9]+\\s-+[-0-9]+\\s-+[0-9:]+\\s-+\\(\\S-.*\\)"
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
85 ;; HP-UX & SunOS tar:
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
86 ;; rwxrwxr-x 501/501 123 Feb 18 15:46 1997 pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
87 ;; Solaris tar (phooey!):
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
88 ;; rwxrwxr-x501/501 123 Feb 18 15:46 1997 pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
89 ;; AIX tar:
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
90 ;; -rw-r--r-- 147 1019 32919 Mar 26 12:00:09 1992 pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
91 "\\S-+\\s-*[-a-z0-9_]+[/ ][-a-z0-9_]+\\s-+[0-9]+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)"
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
92
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
93 ;; djtar:
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
94 ;; drwx Aug 31 02:01:41 1998 123 pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
95 "\\S-+\\s-+[a-z][a-z][a-z]\\s-+[0-9]+\\s-+[0-9:]+\\s-+[0-9]+\\s-+[0-9]+\\s-+\\(\\S-.*\\)"
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
96
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
97 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
98 "List of regexps to use to search for tar filenames.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
99 Note that \"\\(\" and \"\\)\" must be used to delimit the pathname (as
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
100 match #1). Don't put \"^\" to match the beginning of the line; this
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
101 is already implicit, as `looking-at' is used. Filenames can,
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
102 unfortunately, contain spaces, so be careful in constructing any
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
103 regexps.")
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
104
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
105 ;;;###autoload
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
106 (defun package-admin-add-single-file-package (file destdir &optional pkg-dir)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
107 "Install a single file Lisp package into XEmacs package hierarchy.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
108 `file' should be the full path to the lisp file to install.
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
109 `destdir' should be a simple directory name.
243
f220cc83d72e Import from CVS: tag r20-5b20
cvs
parents: 237
diff changeset
110 The optional `pkg-dir' can be used to override the default package hierarchy
274
ca9a9ec9c1c1 Import from CVS: tag r21-0b35
cvs
parents: 243
diff changeset
111 \(car \(last late-packages))."
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
112 (interactive "fLisp File: \nsDestination: ")
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
113 (when (null pkg-dir)
274
ca9a9ec9c1c1 Import from CVS: tag r21-0b35
cvs
parents: 243
diff changeset
114 (setq pkg-dir (car (last late-packages))))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
115 (let ((destination (concat pkg-dir "/lisp/" destdir))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
116 (buf (get-buffer-create package-admin-temp-buffer)))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
117 (call-process "add-little-package.sh"
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
118 nil
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
119 buf
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
120 t
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
121 ;; rest of command line follows
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
122 package-admin-xemacs file destination)))
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
123
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
124 (defun package-admin-install-function-mswindows (file pkg-dir buf)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
125 "Install function for mswindows"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
126 (let ( (default-directory pkg-dir) )
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
127 (call-process "djtar" nil buf t "-x" file)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
128 ))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
129
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
130 (defun package-admin-default-install-function (file pkg-dir buf)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
131 "Default function to install a package.
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
132 Install package FILENAME into directory PKG-DIR, with any messages output
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
133 to buffer BUF."
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
134 (let (filename)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
135 (setq filename (expand-file-name file pkg-dir))
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
136 ;; Don't assume GNU tar.
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
137 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buf)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
138 0
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
139 1)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
140 ))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
141
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
142 ; (call-process "add-big-package.sh"
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
143 ; nil
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
144 ; buf
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
145 ; t
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
146 ; ;; rest of command line follows
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
147 ; package-admin-xemacs file pkg-dir))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
148
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
149 (defun package-admin-get-install-dir (pkg-dir)
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
150 (when (null pkg-dir)
274
ca9a9ec9c1c1 Import from CVS: tag r21-0b35
cvs
parents: 243
diff changeset
151 (when (or (not (listp late-packages))
ca9a9ec9c1c1 Import from CVS: tag r21-0b35
cvs
parents: 243
diff changeset
152 (not late-packages))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
153 (error "No package path"))
274
ca9a9ec9c1c1 Import from CVS: tag r21-0b35
cvs
parents: 243
diff changeset
154 (setq pkg-dir (car (last late-packages))))
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
155 pkg-dir
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
156 )
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
157
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
158 (defun package-admin-get-manifest-file (pkg-topdir package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
159 "Return the name of the MANIFEST file for package PACKAGE.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
160 Note that PACKAGE is a symbol, and not a string."
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
161 (let (dir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
162 (setq dir (expand-file-name "pkginfo" pkg-topdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
163 (expand-file-name (concat "MANIFEST." (symbol-name package)) dir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
164 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
165
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
166 (defun package-admin-check-manifest (pkg-outbuf pkg-topdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
167 "Check for a MANIFEST.<package> file in the package distribution.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
168 If it doesn't exist, create and write one.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
169 PKG-OUTBUF is the buffer that holds the output from `tar', and PKG-TOPDIR
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
170 is the top-level directory under which the package was installed."
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
171 (let ( (manifest-buf " *pkg-manifest*")
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
172 old-case-fold-search regexp package-name pathname regexps)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
173 ;; Save and restore the case-fold-search status.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
174 ;; We do this in case we have to screw with it (as it the case of
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
175 ;; case-insensitive filesystems such as MS Windows).
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
176 (setq old-case-fold-search case-fold-search)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
177 (unwind-protect
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
178 (save-excursion ;; Probably redundant.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
179 (set-buffer (get-buffer pkg-outbuf)) ;; Probably already the
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
180 ;; current buffer.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
181 (goto-char (point-min))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
182
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
183 ;; Make filenames case-insensitive, if necessary
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
184 (if (eq system-type 'windows-nt)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
185 (setq case-fold-search t))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
186
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
187 ;; We really should compute the regexp.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
188 ;; However, directory-sep-char is currently broken, but we need
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
189 ;; functional code *NOW*.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
190 (setq regexp "\\bpkginfo[\\/]MANIFEST\\...*")
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
191
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
192 ;; Look for the manifest.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
193 (if (not (re-search-forward regexp nil t))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
194 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
195 ;; We didn't find a manifest. Make one.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
196
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
197 ;; Yuk. We weren't passed the package name, and so we have
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
198 ;; to dig for it. Look for it as the subdirectory name below
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
199 ;; "lisp", "man", "info", or "etc".
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
200 ;; Here, we don't use a single regexp because we want to search
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
201 ;; the directories for a package name in a particular order.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
202 ;; The problem is that packages could have directories like
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
203 ;; "etc/sounds/" or "etc/photos/" and we don't want to get
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
204 ;; these confused with the actual package name (although, in
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
205 ;; the case of "etc/sounds/", it's probably correct).
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
206 (if (catch 'done
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
207 (let ( (dirs '("lisp" "info" "man" "etc")) rexp)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
208 (while dirs
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
209 (setq rexp (concat "\\b" (car dirs)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
210 "[\\/]\\([^\\/]+\\)[\//]"))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
211 (if (re-search-forward rexp nil t)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
212 (throw 'done t))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
213 (setq dirs (cdr dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
214 )))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
215 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
216 (setq package-name (buffer-substring (match-beginning 1)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
217 (match-end 1)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
218
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
219 ;; Get and erase the manifest buffer
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
220 (setq manifest-buf (get-buffer-create manifest-buf))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
221 (buffer-disable-undo manifest-buf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
222 (erase-buffer manifest-buf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
223
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
224 ;; Now, scan through the output buffer, looking for
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
225 ;; file and directory names.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
226 (goto-char (point-min))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
227 ;; for each line ...
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
228 (while (< (point) (point-max))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
229 (beginning-of-line)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
230 (setq pathname nil)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
231
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
232 ;; scan through the regexps, looking for a pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
233 (if (catch 'found-path
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
234 (setq regexps package-admin-tar-filename-regexps)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
235 (while regexps
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
236 (if (looking-at (car regexps))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
237 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
238 (setq pathname
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
239 (buffer-substring
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
240 (match-beginning 1)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
241 (match-end 1)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
242 (throw 'found-path t)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
243 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
244 (setq regexps (cdr regexps))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
245 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
246 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
247 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
248 ;; found a pathname -- add it to the manifest
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
249 ;; buffer
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
250 (save-excursion
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
251 (set-buffer manifest-buf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
252 (goto-char (point-max))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
253 (insert pathname "\n")
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
254 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
255 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
256 (forward-line 1)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
257 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
258
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
259 ;; Processed all lines.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
260 ;; Now, create the file, pkginfo/MANIFEST.<pkgname>
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
261
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
262 ;; We use `expand-file-name' instead of `concat',
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
263 ;; for portability.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
264 (setq pathname (expand-file-name "pkginfo"
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
265 pkg-topdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
266 ;; Create pkginfo, if necessary
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
267 (if (not (file-directory-p pathname))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
268 (make-directory pathname))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
269 (setq pathname (expand-file-name
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
270 (concat "MANIFEST." package-name)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
271 pathname))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
272 (save-excursion
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
273 (set-buffer manifest-buf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
274 ;; Put the files in sorted order
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
275 (sort-lines nil (point-min) (point-max))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
276 ;; Write the file.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
277 ;; Note that using `write-region' *BYPASSES* any check
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
278 ;; to see if XEmacs is currently editing/visiting the
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
279 ;; file.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
280 (write-region (point-min) (point-max) pathname)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
281 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
282 (kill-buffer manifest-buf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
283 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
284 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
285 ;; We can't determine the package name from an extracted
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
286 ;; file in the tar output buffer.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
287 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
288 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
289 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
290 ;; Restore old case-fold-search status
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
291 (setq case-fold-search old-case-fold-search))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
292 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
293
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
294 ;;;###autoload
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
295 (defun package-admin-add-binary-package (file &optional pkg-dir)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
296 "Install a pre-bytecompiled XEmacs package into package hierarchy."
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
297 (interactive "fPackage tarball: ")
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
298 (let ((buf (get-buffer-create package-admin-temp-buffer))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
299 (status 1)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
300 start err-list
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
301 )
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
302 (setq pkg-dir (package-admin-get-install-dir pkg-dir))
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
303 ;; Insure that the current directory doesn't change
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
304 (save-excursion
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
305 (set-buffer buf)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
306 (setq default-directory pkg-dir)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
307 (setq case-fold-search t)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
308 (buffer-disable-undo)
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
309 (goto-char (setq start (point-max)))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
310 (if (= 0 (setq status (funcall package-admin-install-function
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
311 file pkg-dir buf)))
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
312 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
313 ;; First, check for errors.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
314 ;; We can't necessarily rely upon process error codes.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
315 (catch 'done
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
316 (goto-char start)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
317 (setq err-list package-admin-error-messages)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
318 (while err-list
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
319 (if (re-search-forward (car err-list) nil t)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
320 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
321 (setq status 1)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
322 (throw 'done nil)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
323 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
324 (setq err-list (cdr err-list))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
325 )
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
326 )
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
327 ;; Make sure that the MANIFEST file exists
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
328 (package-admin-check-manifest buf pkg-dir)
314
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
329 ))
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
330 )
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
331 status
341dac730539 Import from CVS: tag r21-0b55
cvs
parents: 274
diff changeset
332 ))
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
333
318
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
334 (defun package-admin-rmtree (directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
335 "Delete a directory and all of its contents, recursively.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
336 This is a feeble attempt at making a portable rmdir."
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
337 (let ( (orig-default-directory default-directory) files dirs dir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
338 (unwind-protect
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
339 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
340 (setq directory (file-name-as-directory directory))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
341 (setq files (directory-files directory nil nil nil t))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
342 (setq dirs (directory-files directory nil nil nil 'dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
343 (while dirs
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
344 (setq dir (car dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
345 (if (file-symlink-p dir) ;; just in case, handle symlinks
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
346 (delete-file dir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
347 (if (not (or (string-equal dir ".") (string-equal dir "..")))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
348 (package-admin-rmtree (expand-file-name dir directory))))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
349 (setq dirs (cdr dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
350 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
351 (setq default-directory directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
352 (condition-case err
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
353 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
354 (while files
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
355 (delete-file (car files))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
356 (setq files (cdr files))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
357 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
358 (delete-directory directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
359 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
360 (file-error
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
361 (message "%s: %s: \"%s\"" (nth 1 err) (nth 2 err) (nth 3 err)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
362 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
363 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
364 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
365 (setq default-directory orig-default-directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
366 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
367 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
368
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
369 (defun package-admin-get-lispdir (pkg-topdir package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
370 (let (package-lispdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
371 (if (and (setq package-lispdir (expand-file-name "lisp" pkg-topdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
372 (setq package-lispdir (expand-file-name (symbol-name package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
373 package-lispdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
374 (file-accessible-directory-p package-lispdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
375 package-lispdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
376 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
377
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
378 (defun package-admin-delete-binary-package (package pkg-topdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
379 "Delete a binary installation of PACKAGE below directory PKG-TOPDIR.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
380 PACKAGE is a symbol, not a string."
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
381 (let ( (tmpbuf " *pkg-manifest*") manifest-file package-lispdir dirs file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
382 (if (not pkg-topdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
383 (setq pkg-topdir (package-admin-get-install-dir nil)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
384 (setq manifest-file (package-admin-get-manifest-file pkg-topdir package))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
385 (if (file-exists-p manifest-file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
386 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
387 ;; The manifest file exists! Use it to delete the old distribution.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
388 (message "Removing old files for package \"%s\" ..." package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
389 (sit-for 0)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
390 (setq tmpbuf (get-buffer-create tmpbuf))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
391 (save-excursion
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
392 (set-buffer tmpbuf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
393 (buffer-disable-undo tmpbuf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
394 (erase-buffer tmpbuf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
395 (insert-file-contents manifest-file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
396 (goto-char (point-min))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
397 ;; For each entry in the MANIFEST ...
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
398 (while (< (point) (point-max))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
399 (beginning-of-line)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
400 (setq file (expand-file-name (buffer-substring
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
401 (point)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
402 (save-excursion (end-of-line)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
403 (point)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
404 pkg-topdir))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
405 (if (file-directory-p file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
406 ;; Keep a record of each directory
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
407 (setq dirs (cons file dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
408 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
409 ;; Delete each file.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
410 ;; Make sure that the file is writable.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
411 ;; (This is important under MS Windows.)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
412 (set-file-modes file 438) ;; 438 -> #o666
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
413 (delete-file file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
414 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
415 (forward-line 1)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
416 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
417 ;; Delete empty directories.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
418 (if dirs
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
419 (let ( (orig-default-directory default-directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
420 directory files file )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
421 ;; Make sure we preserve the existing `default-directory'.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
422 (unwind-protect
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
423 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
424 ;; Warning: destructive sort!
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
425 (setq dirs (nreverse (sort dirs 'string<)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
426 ;; For each directory ...
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
427 (while dirs
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
428 (setq directory (file-name-as-directory (car dirs)))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
429 (setq files (directory-files directory))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
430 ;; Delete the directory if it's empty.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
431 (if (catch 'done
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
432 (while files
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
433 (setq file (car files))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
434 (if (and (not (string= file "."))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
435 (not (string= file "..")))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
436 (throw 'done nil))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
437 (setq files (cdr files))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
438 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
439 t)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
440 (delete-directory directory))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
441 (setq dirs (cdr dirs))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
442 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
443 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
444 (setq default-directory orig-default-directory)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
445 )))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
446 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
447 (kill-buffer tmpbuf)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
448 ;; Delete the MANIFEST file
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
449 (set-file-modes manifest-file 438) ;; 438 -> #o666
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
450 (delete-file manifest-file)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
451 (message "Removing old files for package \"%s\" ... done" package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
452 )
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
453 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
454 ;; The manifest file doesn't exist. Fallback to just deleting the
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
455 ;; package-specific lisp directory, if it exists.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
456 ;;
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
457 ;; Delete old lisp directory, if any
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
458 ;; Gads, this is ugly. However, we're not supposed to use `concat'
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
459 ;; in the name of portability.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
460 (if (setq package-lispdir (package-admin-get-lispdir pkg-topdir
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
461 package))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
462 (progn
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
463 (message "Removing old lisp directory \"%s\" ..."
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
464 package-lispdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
465 (sit-for 0)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
466 (package-admin-rmtree package-lispdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
467 (message "Removing old lisp directory \"%s\" ... done"
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
468 package-lispdir)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
469 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
470 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
471 ;; Delete the package from the database of installed packages.
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
472 (package-delete-name package)
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
473 ))
afd57c14dfc8 Import from CVS: tag r21-0b57
cvs
parents: 314
diff changeset
474
217
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
475 (provide 'package-admin)
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
476
d44af0c54775 Import from CVS: tag r20-4b7
cvs
parents:
diff changeset
477 ;;; package-admin.el ends here