comparison lisp/package-admin.el @ 1410:44de306310b8

[xemacs-hg @ 2003-04-14 03:40:26 by youngs] 2003-04-14 Steve Youngs <youngs@xemacs.org> * package-admin.el (package-admin-find-top-directory): Use 'directory-sep-char'. (package-admin-get-install-dir): Ditto. This is so PUI won't break on platforms that don't use '/' as the directory separator. * package-get.el (package-get-pgp-available-p): New. (package-get-require-signed-base-updates): Use it. (package-get-update-base-from-buffer): Move the code that finds the gpg stuff into `package-get-pgp-available-p'. Now if you have Mailcrypt and a PGP binary installed and set up on your system, PUI will automatically default to doing PGP verification, otherwise it'll default to off. (package-get-require-base): Use the DATUM arg to `error'. (package-get-locate-index-file): Ditto. (package-get-update-base): Ditto. (package-get-update-base-entries): Ditto. (package-get-all): Ditto. (package-get-dependencies): Ditto. (package-get-info): Ditto. (package-get): Ditto. * package-info.el (batch-update-package-info): Use the DATUM arg to `error'. * package-net.el (package-net-batch-generate-bin-ini): Use the DATUM arg to `error'. * package-ui.el (pui-toggle-package-key): Use the DATUM arg to `error'. (pui-toggle-package-delete-key): Ditto. (pui-install-selected-packages): Ditto. (pui-add-required-packages): Ditto. (pui-display-info): Ditto. (list-packages-mode): Ditto. * packages.el (package-require): Use the DATUM arg to `error'.
author youngs
date Mon, 14 Apr 2003 03:40:27 +0000
parents 69a674f5861f
children a939d086aa0f
comparison
equal deleted inserted replaced
1409:d9b958c0f772 1410:44de306310b8
1 ;;; package-admin.el --- Installation and Maintenance of XEmacs packages 1 ;;; package-admin.el --- Installation and Maintenance of XEmacs packages
2 2
3 ;; Copyright (C) 1997 by Free Software Foundation, Inc. 3 ;; Copyright (C) 1997 by Free Software Foundation, Inc.
4 ;; Copyright (C) 2003, Steve Youngs.
4 5
5 ;; Author: SL Baur <steve@xemacs.org> 6 ;; Author: SL Baur <steve@xemacs.org>
6 ;; Keywords: internal 7 ;; Keywords: internal
7 8
8 ;; This file is part of XEmacs. 9 ;; This file is part of XEmacs.
170 ;; First, check the environment var. 171 ;; First, check the environment var.
171 (if env-value 172 (if env-value
172 (let ((path-list (paths-decode-directory-path env-value 'drop-empties))) 173 (let ((path-list (paths-decode-directory-path env-value 'drop-empties)))
173 (cond ((eq type 'std) 174 (cond ((eq type 'std)
174 (while path-list 175 (while path-list
175 (if (equal (substring (car path-list) -16) "xemacs-packages/") 176 (if (equal (substring (car path-list) -16)
177 (concat "xemacs-packages" directory-sep-char))
176 (setq top-dir (car path-list))) 178 (setq top-dir (car path-list)))
177 (setq path-list (cdr path-list)))) 179 (setq path-list (cdr path-list))))
178 ((eq type 'mule) 180 ((eq type 'mule)
179 (while path-list 181 (while path-list
180 (if (equal (substring (car path-list) -14) "mule-packages/") 182 (if (equal (substring (car path-list) -14)
183 (concat "mule-packages" directory-sep-char))
181 (setq top-dir (car path-list))) 184 (setq top-dir (car path-list)))
182 (setq path-list (cdr path-list))))))) 185 (setq path-list (cdr path-list)))))))
183 ;; Wasn't in the environment, try `user-init-directory' if 186 ;; Wasn't in the environment, try `user-init-directory' if
184 ;; USER-DIR is non-nil. 187 ;; USER-DIR is non-nil.
185 (if (and user-dir 188 (if (and user-dir
195 (let ((path-list (nth 1 (packages-find-packages 198 (let ((path-list (nth 1 (packages-find-packages
196 emacs-data-roots 199 emacs-data-roots
197 (packages-compute-package-locations user-init-directory))))) 200 (packages-compute-package-locations user-init-directory)))))
198 (cond ((eq type 'std) 201 (cond ((eq type 'std)
199 (while path-list 202 (while path-list
200 (if (equal (substring (car path-list) -16) "xemacs-packages/") 203 (if (equal (substring (car path-list) -16)
204 (concat "xemacs-packages" directory-sep-char))
201 (setq top-dir (car path-list))) 205 (setq top-dir (car path-list)))
202 (setq path-list (cdr path-list)))) 206 (setq path-list (cdr path-list))))
203 ((eq type 'mule) 207 ((eq type 'mule)
204 (while path-list 208 (while path-list
205 (if (equal (substring (car path-list) -14) "mule-packages/") 209 (if (equal (substring (car path-list) -14)
210 (concat "mule-packages" directory-sep-char))
206 (setq top-dir (car path-list))) 211 (setq top-dir (car path-list)))
207 (setq path-list (cdr path-list))))))) 212 (setq path-list (cdr path-list)))))))
208 ;; Now return either the directory or nil. 213 ;; Now return either the directory or nil.
209 top-dir)) 214 top-dir))
210 215
257 (cond ((equal type "standard") 262 (cond ((equal type "standard")
258 (setq pkg-dir (package-admin-find-top-directory 'std))) 263 (setq pkg-dir (package-admin-find-top-directory 'std)))
259 ((equal type "mule") 264 ((equal type "mule")
260 (setq pkg-dir (package-admin-find-top-directory 'mule))) 265 (setq pkg-dir (package-admin-find-top-directory 'mule)))
261 (t 266 (t
262 (error "Invalid package type"))) 267 (error 'invalid-operation
268 "Invalid package type")))
263 (if (and pkg-dir 269 (if (and pkg-dir
264 (file-writable-p (directory-file-name pkg-dir))) 270 (file-writable-p (directory-file-name pkg-dir)))
265 pkg-dir 271 pkg-dir
266 ;; Oh no! Either we still haven't found a suitable 272 ;; Oh no! Either we still haven't found a suitable
267 ;; directory, or we can't write to the one we did find. 273 ;; directory, or we can't write to the one we did find.
272 (cond ((equal type "standard") 278 (cond ((equal type "standard")
273 (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir))) 279 (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
274 ((equal type "mule") 280 ((equal type "mule")
275 (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir))) 281 (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir)))
276 (t 282 (t
277 (error "Invalid package type"))) 283 (error 'invalid-operation
284 "Invalid package type")))
278 ;; Turn on `package-get-install-to-user-init-directory' 285 ;; Turn on `package-get-install-to-user-init-directory'
279 ;; so we don't get asked for each package we try to 286 ;; so we don't get asked for each package we try to
280 ;; install in this session. 287 ;; install in this session.
281 (setq package-get-install-to-user-init-directory t) 288 (setq package-get-install-to-user-init-directory t)
282 pkg-dir) 289 pkg-dir)
283 ;; If we get to here XEmacs can't make up its mind and 290 ;; If we get to here XEmacs can't make up its mind and
284 ;; neither can the user, nothing left to do except barf. :-( 291 ;; neither can the user, nothing left to do except barf. :-(
285 (error "Can't find suitable installation directory for package: %s" package))))))))) 292 (error 'search-failed
293 (format
294 "Can't find suitable installation directory for package: %s"
295 package))))))))))
286 296
287 (defun package-admin-get-manifest-file (pkg-topdir package) 297 (defun package-admin-get-manifest-file (pkg-topdir package)
288 "Return the name of the MANIFEST file for package PACKAGE. 298 "Return the name of the MANIFEST file for package PACKAGE.
289 Note that PACKAGE is a symbol, and not a string." 299 Note that PACKAGE is a symbol, and not a string."
290 (let ((dir (file-name-as-directory 300 (let ((dir (file-name-as-directory