Mercurial > hg > xemacs-beta

comparison lisp/package-admin.el @ 1378:69a674f5861f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-03-24 16:30:55 by youngs] 2003-03-25 Steve Youngs <youngs@xemacs.org> * package-admin.el: (package-admin-delete-binary-package): Only delete the lisp directory if it exists. (package-admin-find-top-directory): New. (package-admin-get-install-dir): Use it. * package-get.el (package-get-install-to-user-init-directory): New. If non-nil install packages under `user-init-directory'. (package-get): `package-admin-get-install-dir' only takes 2 args. * package-ui.el (pui-install-selected-packages): The 2nd arg to `package-admin-get-install-dir' is optional, no need to specify nil.
author youngs
date Mon, 24 Mar 2003 16:30:56 +0000
parents 02909207294a
children 44de306310b8
comparison
equal deleted inserted replaced
1377:19738a2a5138 1378:69a674f5861f
133 ;; Don't assume GNU tar. 133 ;; Don't assume GNU tar.
134 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer) 134 (if (shell-command (concat "gunzip -c " filename " | tar xvf -") buffer)
135 0 135 0
136 1))) 136 1)))
137 137
138 (defun package-admin-get-install-dir (package pkg-dir &optional mule-related) 138 ;; A few things needed by the following 2 functions.
139 "If PKG-DIR is non-nil return that, 139 (eval-when-compile
140 else return the current location of the package if it is already installed 140 (require 'packages)
141 or return a location appropriate for the package otherwise." 141 (autoload 'package-get-info "package-get")
142 (if pkg-dir 142 (autoload 'paths-decode-directory-path "find-paths")
143 (defvar package-get-install-to-user-init-directory))
144
145 (defun package-admin-find-top-directory (type &optional user-dir)
146 "Return the top level directory for a package.
147
148 Argument TYPE is a symbol that determines the type of package we're
149 trying to find a directory for.
150
151 Optional Argument USER-DIR if non-nil use directories off
152 `user-init-directory'. This overrides everything except
153 \"EMACSPACKAGEPATH\".
154
155 This function honours the environment variable \"EMACSPACKAGEPATH\"
156 and returns directories found there as a priority. If that variable
157 doesn't exist and USER-DIR is nil, check in the normal places.
158
159 If we still can't find a suitable directory, return nil.
160
161 Possible values for TYPE are:
162
163 std == For \"standard\" packages that go in '/xemacs-packages/'
164 mule == For \"mule\" packages that go in '/mule-packages/'
165 site == For \"unsupported\" packages that go in '/site-packages/'
166
167 Note: Type \"site\" is not yet fully supported."
168 (let* ((env-value (getenv "EMACSPACKAGEPATH"))
169 top-dir)
170 ;; First, check the environment var.
171 (if env-value
172 (let ((path-list (paths-decode-directory-path env-value 'drop-empties)))
173 (cond ((eq type 'std)
174 (while path-list
175 (if (equal (substring (car path-list) -16) "xemacs-packages/")
176 (setq top-dir (car path-list)))
177 (setq path-list (cdr path-list))))
178 ((eq type 'mule)
179 (while path-list
180 (if (equal (substring (car path-list) -14) "mule-packages/")
181 (setq top-dir (car path-list)))
182 (setq path-list (cdr path-list)))))))
183 ;; Wasn't in the environment, try `user-init-directory' if
184 ;; USER-DIR is non-nil.
185 (if (and user-dir
186 (not top-dir))
187 (cond ((eq type 'std)
188 (setq top-dir (file-name-as-directory
189 (expand-file-name "xemacs-packages" user-init-directory))))
190 ((eq type 'mule)
191 (setq top-dir (file-name-as-directory
192 (expand-file-name "mule-packages" user-init-directory))))))
193 ;; Finally check the normal places
194 (if (not top-dir)
195 (let ((path-list (nth 1 (packages-find-packages
196 emacs-data-roots
197 (packages-compute-package-locations user-init-directory)))))
198 (cond ((eq type 'std)
199 (while path-list
200 (if (equal (substring (car path-list) -16) "xemacs-packages/")
201 (setq top-dir (car path-list)))
202 (setq path-list (cdr path-list))))
203 ((eq type 'mule)
204 (while path-list
205 (if (equal (substring (car path-list) -14) "mule-packages/")
206 (setq top-dir (car path-list)))
207 (setq path-list (cdr path-list)))))))
208 ;; Now return either the directory or nil.
209 top-dir))
210
211 (defun package-admin-get-install-dir (package &optional pkg-dir)
212 "Find a suitable installation directory for a package.
213
214 Argument PACKAGE is the package to find a installation directory for.
215 Optional Argument PKG-DIR, if non-nil is a directory to use for
216 installation.
217
218 If PKG-DIR is non-nil and writable, return that. Otherwise check to
219 see if the PACKAGE is already installed and return that location, if
220 it is writable. Finally, fall back to the `user-init-directory' if
221 all else fails. As a side effect of installing packages under
222 `user-init-directory' these packages become part of `early-packages'."
223 ;; If pkg-dir specified, return that if writable.
224 (if (and pkg-dir
225 (file-writable-p (directory-file-name pkg-dir)))
143 pkg-dir 226 pkg-dir
144 (let ((package-feature (intern-soft (concat 227 ;; If the user want her packages under ~/.xemacs/, do so.
145 (symbol-name package) "-autoloads"))) 228 (let ((type (package-get-info package 'category)))
146 autoload-dir) 229 (if package-get-install-to-user-init-directory
147 (when (and (not (eq package 'unknown)) 230 (progn
148 (featurep package-feature) 231 (cond ((equal type "standard")
149 (setq autoload-dir (feature-file package-feature)) 232 (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
150 (setq autoload-dir (file-name-directory autoload-dir)) 233 ((equal type "mule")
151 (member autoload-dir (append early-package-load-path late-package-load-path))) 234 (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir))))
152 ;; Find the corresponding entry in late-package 235 pkg-dir)
153 (setq pkg-dir 236 ;; Maybe the package has been installed before, if so, return
154 (car-safe (member-if (lambda (h) 237 ;; that directory.
155 (string-match (concat "^" (regexp-quote h)) 238 (let ((package-feature (intern-soft (concat
156 autoload-dir)) 239 (symbol-name package) "-autoloads")))
157 (append (cdr early-packages) late-packages))))) 240 autoload-dir)
158 (if pkg-dir 241 (when (and (not (eq package 'unknown))
159 pkg-dir 242 (featurep package-feature)
160 ;; Ok we need to guess 243 (setq autoload-dir (feature-file package-feature))
161 (if mule-related 244 (setq autoload-dir (file-name-directory autoload-dir))
162 (package-admin-get-install-dir 'mule-base nil nil) 245 (member autoload-dir (append early-package-load-path late-package-load-path)))
163 (car (last late-packages))))))) 246 ;; Find the corresponding entry in late-package
247 (setq pkg-dir
248 (car-safe (member-if (lambda (h)
249 (string-match (concat "^" (regexp-quote h))
250 autoload-dir))
251 (append (cdr early-packages) late-packages)))))
252 (if (and pkg-dir
253 (file-writable-p (directory-file-name pkg-dir)))
254 pkg-dir
255 ;; OK, the package hasn't been previously installed so we need
256 ;; to guess where it should go.
257 (cond ((equal type "standard")
258 (setq pkg-dir (package-admin-find-top-directory 'std)))
259 ((equal type "mule")
260 (setq pkg-dir (package-admin-find-top-directory 'mule)))
261 (t
262 (error "Invalid package type")))
263 (if (and pkg-dir
264 (file-writable-p (directory-file-name pkg-dir)))
265 pkg-dir
266 ;; Oh no! Either we still haven't found a suitable
267 ;; directory, or we can't write to the one we did find.
268 ;; Drop back to the `user-init-directory'.
269 (if (y-or-n-p (format "Directory isn't writable, use %s instead? "
270 user-init-directory))
271 (progn
272 (cond ((equal type "standard")
273 (setq pkg-dir (package-admin-find-top-directory 'std 'user-dir)))
274 ((equal type "mule")
275 (setq pkg-dir (package-admin-find-top-directory 'mule 'user-dir)))
276 (t
277 (error "Invalid package type")))
278 ;; Turn on `package-get-install-to-user-init-directory'
279 ;; so we don't get asked for each package we try to
280 ;; install in this session.
281 (setq package-get-install-to-user-init-directory t)
282 pkg-dir)
283 ;; If we get to here XEmacs can't make up its mind and
284 ;; neither can the user, nothing left to do except barf. :-(
285 (error "Can't find suitable installation directory for package: %s" package)))))))))
164 286
165 (defun package-admin-get-manifest-file (pkg-topdir package) 287 (defun package-admin-get-manifest-file (pkg-topdir package)
166 "Return the name of the MANIFEST file for package PACKAGE. 288 "Return the name of the MANIFEST file for package PACKAGE.
167 Note that PACKAGE is a symbol, and not a string." 289 Note that PACKAGE is a symbol, and not a string."
168 (let ((dir (file-name-as-directory 290 (let ((dir (file-name-as-directory
407 ;; 529 ;;
408 ;; Delete old lisp directory, if any 530 ;; Delete old lisp directory, if any
409 ;; Gads, this is ugly. However, we're not supposed to use `concat' 531 ;; Gads, this is ugly. However, we're not supposed to use `concat'
410 ;; in the name of portability. 532 ;; in the name of portability.
411 (setq package-lispdir (package-admin-get-lispdir pkg-topdir package)) 533 (setq package-lispdir (package-admin-get-lispdir pkg-topdir package))
412 (message "Removing old lisp directory \"%s\" ..." package-lispdir) 534 (when package-lispdir
413 (sit-for 0) 535 (message "Removing old lisp directory \"%s\" ..." package-lispdir)
414 (package-admin-rmtree package-lispdir) 536 (sit-for 0)
415 (message "Removing old lisp directory \"%s\" ... done" package-lispdir)) 537 (package-admin-rmtree package-lispdir)
538 (message "Removing old lisp directory \"%s\" ... done" package-lispdir)))
416 ;; Delete the package from the database of installed packages. 539 ;; Delete the package from the database of installed packages.
417 (package-delete-name package))) 540 (package-delete-name package)))
418 541
419 (provide 'package-admin) 542 (provide 'package-admin)
420 543