Mercurial > hg > xemacs-beta
comparison lisp/package-get.el @ 1365:02909207294a
[xemacs-hg @ 2003-03-20 13:19:56 by youngs]
2003-03-20 Steve Youngs <youngs@xemacs.org>
* menubar-items.el (default-menubar): Add a "Pre-Release Download
Sites" submenu to "Tools -> Packages" menu.
Filter the package download sites menus through
`menu-split-long-menu'.
* obsolete.el (pui-add-install-directory): New.
(package-get-download-menu): New.
* package-admin.el: (package-admin-add-single-file-package):
Removed.
(package-admin-get-install-dir): Don't rely on an installed
xemacs-base package to guess where a package needs to be installed
to.
(package-admin-get-manifest-file): Whitespace clean up.
(package-admin-check-manifest): Use `directory-sep-char' to
compute regexp.
Only search 'lisp' and 'man' directories to determine package
name.
Don't error is xemacs-base package isn't installed, just don't
sort the MANIFEST file and issue a warning.
(package-admin-add-binary-package): Whitespace clean up.
(package-admin-get-lispdir): Ditto.
(package-admin-delete-binary-package): Use `with-temp-buffer'
instead of creating a temporary buffer manually.
* package-get.el: (package-get-remote): Change custom type so that
only either a single directory or remote host:directory can be
selected.
(package-get-download-sites): Put the sites into alphabetical
order of country.
Make the description element be "Country (site)" instead of the
other way around.
(package-get-pre-release-download-sites): New.
(package-get-require-signed-base-updates): Default to t.
(package-get-download-menu): Removed.
(package-get-locate-file): Change to reflect new format of
'package-get-remote'.
(package-get-update-base-from-buffer): Whitespace clean up and
remove an unneccessary 'when'.
(package-get-interactive-package-query): Whitespace clean up.
(package-get-update-all): Ditto.
(package-get-all): Ditto.
(package-get-init-package): Ditto.
(package-get-info): New.
(package-get): Bring into line with new format of
'package-get-remote'.
Error if non-Mule XEmacsen try to install Mule packages.
Don't rely on a Mule package having 'mule-base' in its
"REQUIRES" to determine if it is a Mule package or not,
instead we test "CATEGORY".
Better handling of the situation where a partial package tarball
exists on the local hard drive from a previous interupted
download.
Clean up after a failed package install.
(package-get-set-version-prop): Removed.
(package-get-installedp): Whitespace clean up.
* package-ui.el: Whitespace clean up.
(pui-info-buffer): Make it a defcustom.
(pui-directory-exists): Removed.
(pui-package-dir-list): Removed.
(pui-add-install-directory): Removed.
(package-ui-download-menu): New.
(package-ui-pre-release-download-menu): New.
(pui-set-local-package-get-directory): New.
(pui-package-symbol-char): Whitespace clean up.
(pui-update-package-display): Ditto.
(pui-toggle-package): Ditto.
(pui-toggle-package-key): Ditto.
(pui-toggle-package-delete): Ditto.
(pui-toggle-package-delete-key): Ditto.
(pui-toggle-package-event): Ditto.
(pui-toggle-verbosity-redisplay): Ditto.
(pui-install-selected-packages): Ditto.
(pui-help-echo): Ditto.
(pui-display-info): Ditto.
(pui-list-packages): Ditto.
* packages.el: Whitespace clean up.
| author | youngs |
|---|---|
| date | Thu, 20 Mar 2003 13:19:59 +0000 |
| parents | 184461bc8de4 |
| children | 1aba3abebad6 |
comparison
equal
deleted
inserted
replaced
| 1364:29e39e3ac319 | 1365:02909207294a |
|---|---|
| 170 (define-widget 'host-name 'string | 170 (define-widget 'host-name 'string |
| 171 "A Host name." | 171 "A Host name." |
| 172 :tag "Host") | 172 :tag "Host") |
| 173 | 173 |
| 174 (defcustom package-get-remote nil | 174 (defcustom package-get-remote nil |
| 175 "*List of remote sites to contact for downloading packages. | 175 "*The remote site to contact for downloading packages. |
| 176 List format is '(site-name directory-on-site). Each site is tried in | 176 Format is '(site-name directory-on-site). As a special case, `site-name' |
| 177 order until the package is found. As a special case, `site-name' can be | 177 can be `nil', in which case `directory-on-site' is treated as a local |
| 178 `nil', in which case `directory-on-site' is treated as a local directory." | 178 directory." |
| 179 :tag "Package repository" | 179 :tag "Package repository" |
| 180 :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory ) | 180 :type '(set (choice (const :tag "None" nil) |
| 181 (list :tag "Remote" host-name directory) )) | 181 (list :tag "Local" (const :tag "Local" nil) directory) |
| 182 (list :tag "Remote" host-name directory))) | |
| 182 :group 'package-get) | 183 :group 'package-get) |
| 183 | 184 |
| 184 ;;;###autoload | 185 ;;;###autoload |
| 185 (defcustom package-get-download-sites | 186 (defcustom package-get-download-sites |
| 186 '( | 187 '( |
| 187 ;; North America | 188 ;; Main XEmacs Site (ftp.xemacs.org) |
| 188 ("Pre-Releases" "ftp.xemacs.org" "pub/xemacs/beta/experimental/packages") | 189 ("US (Main XEmacs Site)" |
| 189 ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages") | 190 "ftp.xemacs.org" "pub/xemacs/packages") |
| 190 ("ca.xemacs.org (Canada)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages") | 191 ;; In alphabetical order of Country, our mirrors... |
| 191 ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages") | 192 ("Australia (aarnet.edu.au)" "mirror.aarnet.edu.au" "pub/xemacs/packages") |
| 192 ("us.xemacs.org (United States)" "ftp.us.xemacs.org" "pub/xemacs/packages") | 193 ("Australia (au.xemacs.org)" "ftp.au.xemacs.org" "pub/xemacs/packages") |
| 193 ("ibiblio.org (United States)" "ibiblio.org" "pub/packages/editors/xemacs/packages") | 194 ("Austria (at.xemacs.org)" "ftp.at.xemacs.org" "editors/xemacs/packages") |
| 194 ("stealth.net (United States)" "ftp.stealth.net" "pub/mirrors/ftp.xemacs.org/pub/xemacs/packages") | 195 ("Belgium (be.xemacs.org)" "ftp.be.xemacs.org" "xemacs/packages") |
| 195 ;("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages") | 196 ("Brazil (br.xemacs.org)" "ftp.br.xemacs.org" "pub/xemacs/packages") |
| 196 | 197 ("Canada (ca.xemacs.org)" "ftp.ca.xemacs.org" "pub/Mirror/xemacs/packages") |
| 197 ;; South America | 198 ("Canada (crc.ca)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages") |
| 198 ("br.xemacs.org (Brazil)" "ftp.br.xemacs.org" "pub/xemacs/packages") | 199 ("Czech Republic (cz.xemacs.org)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages") |
| 199 | 200 ("Denmark (dk.xemacs.org)" "ftp.dk.xemacs.org" "pub/emacs/xemacs/packages") |
| 200 ;; Europe | 201 ("Finland (fi.xemacs.org)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages") |
| 201 ("at.xemacs.org (Austria)" "ftp.at.xemacs.org" "editors/xemacs/packages") | 202 ("France (fr.xemacs.org)" "ftp.fr.xemacs.org" "pub/xemacs/packages") |
| 202 ("be.xemacs.org (Belgium)" "ftp.be.xemacs.org" "xemacs/packages") | 203 ("France (pasteur.fr)" "ftp.pasteur.fr" "pub/computing/xemacs/packages") |
| 203 ("cz.xemacs.org (Czech Republic)" "ftp.cz.xemacs.org" "MIRRORS/ftp.xemacs.org/pub/xemacs/packages") | 204 ("Germany (de.xemacs.org)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages") |
| 204 ("dk.xemacs.org (Denmark)" "ftp.dk.xemacs.org" "pub/emacs/xemacs/packages") | 205 ("Germany (tu-darmstadt.de)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") |
| 205 ("fi.xemacs.org (Finland)" "ftp.fi.xemacs.org" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages") | 206 ("Ireland (ie.xemacs.org)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages") |
| 206 ("fr.xemacs.org (France)" "ftp.fr.xemacs.org" "pub/xemacs/packages") | 207 ("Italy (it.xemacs.org)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages") |
| 207 ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages") | 208 ("Japan (aist.go.jp)" "ring.aist.go.jp" "pub/text/xemacs/packages") |
| 208 ("de.xemacs.org (Germany)" "ftp.de.xemacs.org" "pub/ftp.xemacs.org/tux/xemacs/packages") | 209 ("Japan (asahi-net.or.jp)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") |
| 209 ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages") | 210 ("Japan (dti.ad.jp)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") |
| 210 ;("hu.xemacs.org (Hungary)" "ftp.hu.xemacs.org" "pub/packages/xemacs/packages") | 211 ("Japan (jaist.ac.jp)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") |
| 211 ("ie.xemacs.org (Ireland)" "ftp.ie.xemacs.org" "mirrors/ftp.xemacs.org/pub/xemacs/packages") | 212 ("Japan (jp.xemacs.org)" "ftp.jp.xemacs.org" "pub/GNU/xemacs/packages") |
| 212 ("it.xemacs.org (Italy)" "ftp.it.xemacs.org" "unix/packages/XEMACS/packages") | 213 ("Japan (nucba.ac.jp)" "mirror.nucba.ac.jp" "mirror/xemacs/packages") |
| 213 ("no.xemacs.org (Norway)" "ftp.no.xemacs.org" "pub/xemacs/packages") | 214 ("Japan (sut.ac.jp)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages") |
| 214 ("pl.xemacs.org (Poland)" "ftp.pl.xemacs.org" "pub/unix/editors/xemacs/packages") | 215 ("Korea (kr.xemacs.org))" "ftp.kr.xemacs.org" "pub/tools/emacs/xemacs/packages") |
| 215 ("ru.xemacs.org (Russia)" "ftp.ru.xemacs.org" "pub/xemacs/packages") | 216 ("Norway (no.xemacs.org)" "ftp.no.xemacs.org" "pub/xemacs/packages") |
| 216 ("sk.xemacs.org (Slovakia)" "ftp.sk.xemacs.org" "pub/mirrors/xemacs/packages") | 217 ("Poland (pl.xemacs.org)" "ftp.pl.xemacs.org" "pub/unix/editors/xemacs/packages") |
| 217 ("se.xemacs.org (Sweden)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages") | 218 ("Russia (ru.xemacs.org)" "ftp.ru.xemacs.org" "pub/xemacs/packages") |
| 218 ("ch.xemacs.org (Switzerland)" "ftp.ch.xemacs.org" "mirror/xemacs/packages") | 219 ("Slovakia (sk.xemacs.org)" "ftp.sk.xemacs.org" "pub/mirrors/xemacs/packages") |
| 219 ("uk.xemacs.org (United Kingdom)" "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages") | 220 ("South Africa (za.xemacs.org)" "ftp.za.xemacs.org" "mirrorsites/ftp.xemacs.org/packages") |
| 220 | 221 ("Sweden (se.xemacs.org)" "ftp.se.xemacs.org" "pub/gnu/xemacs/packages") |
| 221 ;; Asia | 222 ("Switzerland (ch.xemacs.org)" "ftp.ch.xemacs.org" "mirror/xemacs/packages") |
| 222 ("jp.xemacs.org (Japan)" "ftp.jp.xemacs.org" "pub/GNU/xemacs/packages") | 223 ("UK (uk.xemacs.org)" "ftp.uk.xemacs.org" "sites/ftp.xemacs.org/pub/xemacs/packages") |
| 223 ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages") | 224 ("US (ibiblio.org)" "ibiblio.org" "pub/packages/editors/xemacs/packages") |
| 224 ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages") | 225 ("US (stealth.net)" "ftp.stealth.net" "pub/mirrors/ftp.xemacs.org/pub/xemacs/packages") |
| 225 ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages") | 226 ("US (us.xemacs.org)" "ftp.us.xemacs.org" "pub/xemacs/packages")) |
| 226 ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages") | |
| 227 ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages") | |
| 228 ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages") | |
| 229 ("kr.xemacs.org (Korea)" "ftp.kr.xemacs.org" "pub/tools/emacs/xemacs/packages") | |
| 230 ;("tw.xemacs.org (Taiwan)" "ftp.tw.xemacs.org" "Editors/xemacs/packages") | |
| 231 | |
| 232 ;; Africa | |
| 233 ("za.xemacs.org (South Africa)" "ftp.za.xemacs.org" "mirrorsites/ftp.xemacs.org/packages") | |
| 234 | |
| 235 ;; Middle East | |
| 236 ("sa.xemacs.org (Saudi Arabia)" "ftp.sa.xemacs.org" "pub/mirrors/ftp.xemacs.org/xemacs/packages") | |
| 237 | |
| 238 ;; Australia | |
| 239 ("au.xemacs.org (Australia)" "ftp.au.xemacs.org" "pub/xemacs/packages") | |
| 240 ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages") | |
| 241 | |
| 242 ;; Oceania | |
| 243 ("nz.xemacs.org (New Zealand)" "ftp.nz.xemacs.org" "mirror/ftp.xemacs.org/packages") | |
| 244 ) | |
| 245 "*List of remote sites available for downloading packages. | 227 "*List of remote sites available for downloading packages. |
| 246 List format is '(site-description site-name directory-on-site). | 228 List format is '(site-description site-name directory-on-site). |
| 247 SITE-DESCRIPTION is a textual description of the site. SITE-NAME | 229 SITE-DESCRIPTION is a textual description of the site. SITE-NAME |
| 248 is the internet address of the download site. DIRECTORY-ON-SITE | 230 is the internet address of the download site. DIRECTORY-ON-SITE |
| 249 is the directory on the site in which packages may be found. | 231 is the directory on the site in which packages may be found. |
| 251 variable actually used to specify package download sites." | 233 variable actually used to specify package download sites." |
| 252 :tag "Package download sites" | 234 :tag "Package download sites" |
| 253 :type '(repeat (list (string :tag "Name") host-name directory)) | 235 :type '(repeat (list (string :tag "Name") host-name directory)) |
| 254 :group 'package-get) | 236 :group 'package-get) |
| 255 | 237 |
| 238 ;;;###autoload | |
| 239 (defcustom package-get-pre-release-download-sites | |
| 240 '( | |
| 241 ;; Main XEmacs Site (ftp.xemacs.org) | |
| 242 ("Pre-Releases (Main XEmacs Site)" "ftp.xemacs.org" | |
| 243 "pub/xemacs/beta/experimental/packages") | |
| 244 ;; In alphabetical order of Country, our mirrors... | |
| 245 ("Australia Pre-Releases (aarnet.edu.au)" "mirror.aarnet.edu.au" | |
| 246 "pub/xemacs/beta/experimental/packages") | |
| 247 ("Australia Pre-Releases (au.xemacs.org)" "ftp.au.xemacs.org" | |
| 248 "pub/xemacs/beta/experimental/packages") | |
| 249 ("Austria Pre-Releases (at.xemacs.org)" "ftp.at.xemacs.org" | |
| 250 "editors/xemacs/beta/experimentsl/packages") | |
| 251 ("Brazil Pre-Releases (br.xemacs.org)" "ftp.br.xemacs.org" | |
| 252 "pub/xemacs/xemacs-21.5/experimental/packages") | |
| 253 ("Canada Pre-Releases (ca.xemacs.org)" "ftp.ca.xemacs.org" | |
| 254 "pub/Mirror/xemacs/beta/experimental/packages") | |
| 255 ("Canada Pre-Releases (crc.ca)" "ftp.crc.ca" | |
| 256 "pub/packages/editors/xemacs/beta/experimental/packages") | |
| 257 ("Czech Republic Pre-Releases (cz.xemacs.org)" "ftp.cz.xemacs.org" | |
| 258 "MIRRORS/ftp.xemacs.org/pub/xemacs/xemacs-21.5/experimental/packages") | |
| 259 ("Denmark Pre-Releases (dk.xemacs.org)" "ftp.dk.xemacs.org" | |
| 260 "pub/emacs/xemacs/beta/experimental/packages") | |
| 261 ("Finland Pre-Releases (fi.xemacs.org)" "ftp.fi.xemacs.org" | |
| 262 "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/beta/experimental/packages") | |
| 263 ("France Pre-Releases (fr.xemacs.org)" "ftp.fr.xemacs.org" | |
| 264 "pub/xemacs/beta/experimental/packages") | |
| 265 ("France Pre-Releases (pasteur.fr)" "ftp.pasteur.fr" | |
| 266 "pub/computing/xemacs/beta/experimental/packages") | |
| 267 ("Germany Pre-Releases (de.xemacs.org)" "ftp.de.xemacs.org" | |
| 268 "pub/ftp.xemacs.org/tux/xemacs/beta/experimental/packages") | |
| 269 ("Germany Pre-Releases (tu-darmstadt.de)" "ftp.tu-darmstadt.de" | |
| 270 "pub/editors/xemacs/beta/experimental/packages") | |
| 271 ("Ireland Pre-Releases (ie.xemacs.org)" "ftp.ie.xemacs.org" | |
| 272 "mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages") | |
| 273 ("Italy Pre-Releases (it.xemacs.org)" "ftp.it.xemacs.org" | |
| 274 "unix/packages/XEMACS/beta/experimental/packages") | |
| 275 ("Japan Pre-Releases (aist.go.jp)" "ring.aist.go.jp" | |
| 276 "pub/text/xemacs/beta/experimental/packages") | |
| 277 ("Japan Pre-Releases (asahi-net.or.jp)" "ring.asahi-net.or.jp" | |
| 278 "pub/text/xemacs/beta/experimental/packages") | |
| 279 ("Japan Pre-Releases (dti.ad.jp)" "ftp.dti.ad.jp" | |
| 280 "pub/unix/editor/xemacs/beta/experimental/packages") | |
| 281 ("Japan Pre-Releases (jaist.ac.jp)" "ftp.jaist.ac.jp" | |
| 282 "pub/GNU/xemacs/beta/experimental/packages") | |
| 283 ("Japan Pre-Releases (jp.xemacs.org)" "ftp.jp.xemacs.org" | |
| 284 "pub/GNU/xemacs/beta/experimental/packages") | |
| 285 ("Japan Pre-Releases (sut.ac.jp)" "sunsite.sut.ac.jp" | |
| 286 "pub/archives/packages/xemacs/xemacs-21.5/experimental/packages") | |
| 287 ("Norway Pre-Releases (no.xemacs.org)" "ftp.no.xemacs.org" | |
| 288 "pub/xemacs/beta/experimental/packages") | |
| 289 ("Poland Pre-Releases (pl.xemacs.org)" "ftp.pl.xemacs.org" | |
| 290 "pub/unix/editors/xemacs/beta/experimental/packages") | |
| 291 ("Russia Pre-Releases (ru.xemacs.org)" "ftp.ru.xemacs.org" | |
| 292 "pub/xemacs/beta/experimental/packages") | |
| 293 ("Saudi Arabia Pre-Releases (sa.xemacs.org)" "ftp.sa.xemacs.org" | |
| 294 "pub/mirrors/ftp.xemacs.org/xemacs/xemacs-21.5/experimental/packages") | |
| 295 ("Slovakia Pre-Releases (sk.xemacs.org)" "ftp.sk.xemacs.org" | |
| 296 "pub/mirrors/xemacs/beta/experimental/packages") | |
| 297 ("South Africa Pre-Releases (za.xemacs.org)" "ftp.za.xemacs.org" | |
| 298 "mirrorsites/ftp.xemacs.org/beta/experimental/packages") | |
| 299 ("Sweden Pre-Releases (se.xemacs.org)" "ftp.se.xemacs.org" | |
| 300 "pub/gnu/xemacs/beta/experimental/packages") | |
| 301 ("Switzerland Pre-Releases (ch.xemacs.org)" "ftp.ch.xemacs.org" | |
| 302 "mirror/xemacs/beta/experimental/packages") | |
| 303 ("UK Pre-Releases (uk.xemacs.org)" "ftp.uk.xemacs.org" | |
| 304 "sites/ftp.xemacs.org/pub/xemacs/beta/experimental/packages") | |
| 305 ("US Pre-Releases (ibiblio.org)" "ibiblio.org" | |
| 306 "pub/packages/editors/xemacs/beta/experimental/packages") | |
| 307 ("US Pre-Releases (stealth.net)" "ftp.stealth.net" | |
| 308 "pub/mirrors/ftp.xemacs.org/pub/xemacs/beta/experimental/packages") | |
| 309 ("US Pre-Releases (us.xemacs.org)" "ftp.us.xemacs.org" | |
| 310 "pub/xemacs/beta/experimental/packages")) | |
| 311 "*List of remote sites available for downloading \"Pre-Release\" packages. | |
| 312 List format is '(site-description site-name directory-on-site). | |
| 313 SITE-DESCRIPTION is a textual description of the site. SITE-NAME | |
| 314 is the internet address of the download site. DIRECTORY-ON-SITE | |
| 315 is the directory on the site in which packages may be found. | |
| 316 This variable is used to initialize `package-get-remote', the | |
| 317 variable actually used to specify package download sites." | |
| 318 :tag "Pre-Release Package download sites" | |
| 319 :type '(repeat (list (string :tag "Name") host-name directory)) | |
| 320 :group 'package-get) | |
| 321 | |
| 256 (defcustom package-get-remove-copy t | 322 (defcustom package-get-remove-copy t |
| 257 "*After copying and installing a package, if this is t, then remove the | 323 "*After copying and installing a package, if this is t, then remove the |
| 258 copy. Otherwise, keep it around." | 324 copy. Otherwise, keep it around." |
| 259 :type 'boolean | 325 :type 'boolean |
| 260 :group 'package-get) | 326 :group 'package-get) |
| 277 "*If Non-nil always make sure we are using the latest package index (base). | 343 "*If Non-nil always make sure we are using the latest package index (base). |
| 278 Otherwise respect the `force-current' argument of `package-get-require-base'." | 344 Otherwise respect the `force-current' argument of `package-get-require-base'." |
| 279 :type 'boolean | 345 :type 'boolean |
| 280 :group 'package-get) | 346 :group 'package-get) |
| 281 | 347 |
| 282 (defcustom package-get-require-signed-base-updates nil | 348 (defcustom package-get-require-signed-base-updates t |
| 283 "*If set to a non-nil value, require explicit user confirmation for updates | 349 "*If set to a non-nil value, require explicit user confirmation for updates |
| 284 to the package-get database which cannot have their signature verified via PGP. | 350 to the package-get database which cannot have their signature verified via PGP. |
| 285 When nil, no PGP verification will be done." | 351 When nil, no PGP verification will be done." |
| 286 :type 'boolean | 352 :type 'boolean |
| 287 :group 'package-get) | 353 :group 'package-get) |
| 292 (defvar package-get-continue-update-base nil | 358 (defvar package-get-continue-update-base nil |
| 293 "Non-nil update the index even if it hasn't been signed.") | 359 "Non-nil update the index even if it hasn't been signed.") |
| 294 | 360 |
| 295 (defvar package-get-was-current nil | 361 (defvar package-get-was-current nil |
| 296 "Non-nil we did our best to fetch a current database.") | 362 "Non-nil we did our best to fetch a current database.") |
| 297 | |
| 298 | |
| 299 ;Shouldn't this be in package-ui? | |
| 300 ;;;###autoload | |
| 301 (defun package-get-download-menu () | |
| 302 "Build the `Add Download Site' menu." | |
| 303 (mapcar (lambda (site) | |
| 304 (vector (car site) | |
| 305 `(if (member (quote ,(cdr site)) | |
| 306 package-get-remote) | |
| 307 (setq package-get-remote | |
| 308 (delete (quote ,(cdr site)) | |
| 309 package-get-remote)) | |
| 310 (package-ui-add-site (quote ,(cdr site)))) | |
| 311 :style 'toggle | |
| 312 :selected `(member (quote ,(cdr site)) | |
| 313 package-get-remote))) | |
| 314 package-get-download-sites)) | |
| 315 | 363 |
| 316 ;;;###autoload | 364 ;;;###autoload |
| 317 (defun package-get-require-base (&optional force-current) | 365 (defun package-get-require-base (&optional force-current) |
| 318 "Require that a package-get database has been loaded. | 366 "Require that a package-get database has been loaded. |
| 319 If the optional FORCE-CURRENT argument or the value of | 367 If the optional FORCE-CURRENT argument or the value of |
| 354 If optional argument NIL-IF-NOT-FOUND is non-nil, return nil | 402 If optional argument NIL-IF-NOT-FOUND is non-nil, return nil |
| 355 if FILE can not be located. | 403 if FILE can not be located. |
| 356 If NO-REMOTE is non-nil never search remote locations." | 404 If NO-REMOTE is non-nil never search remote locations." |
| 357 (if (file-name-absolute-p file) | 405 (if (file-name-absolute-p file) |
| 358 file | 406 file |
| 359 (let ((entries package-get-remote) | 407 (let ((site package-get-remote) |
| 360 (expanded nil)) | 408 (expanded nil)) |
| 361 (while entries | 409 (when site |
| 362 (unless (and no-remote (caar entries)) | 410 (unless (and no-remote (caar (list site))) |
| 363 (let ((expn (package-get-remote-filename (car entries) file))) | 411 (let ((expn (package-get-remote-filename (car (list site)) file))) |
| 364 (if (and expn (file-exists-p expn)) | 412 (if (and expn (file-exists-p expn)) |
| 365 (setq entries nil | 413 (setq site nil |
| 366 expanded expn)))) | 414 expanded expn))))) |
| 367 (setq entries (cdr entries))) | |
| 368 (or expanded | 415 (or expanded |
| 369 (and (not nil-if-not-found) | 416 (and (not nil-if-not-found) |
| 370 file))))) | 417 file))))) |
| 371 | 418 |
| 372 (defun package-get-locate-index-file (no-remote) | 419 (defun package-get-locate-index-file (no-remote) |
| 391 (unless (and location (file-writable-p location)) | 438 (unless (and location (file-writable-p location)) |
| 392 (setq location package-get-user-index-filename)) | 439 (setq location package-get-user-index-filename)) |
| 393 (when (y-or-n-p (concat "Update package index in " location "? ")) | 440 (when (y-or-n-p (concat "Update package index in " location "? ")) |
| 394 (let ((coding-system-for-write 'binary)) | 441 (let ((coding-system-for-write 'binary)) |
| 395 (write-file location))))))) | 442 (write-file location))))))) |
| 396 | |
| 397 | 443 |
| 398 ;;;###autoload | 444 ;;;###autoload |
| 399 (defun package-get-update-base (&optional db-file force-current) | 445 (defun package-get-update-base (&optional db-file force-current) |
| 400 "Update the package-get database file with entries from DB-FILE. | 446 "Update the package-get database file with entries from DB-FILE. |
| 401 Unless FORCE-CURRENT is non-nil never try to update the database." | 447 Unless FORCE-CURRENT is non-nil never try to update the database." |
| 429 "Update the package-get database with entries from BUFFER. | 475 "Update the package-get database with entries from BUFFER. |
| 430 BUFFER defaults to the current buffer. This command can be | 476 BUFFER defaults to the current buffer. This command can be |
| 431 used interactively, for example from a mail or news buffer." | 477 used interactively, for example from a mail or news buffer." |
| 432 (interactive) | 478 (interactive) |
| 433 (setq buf (or buf (current-buffer))) | 479 (setq buf (or buf (current-buffer))) |
| 434 (let (content-beg content-end ;beg end | 480 (let (content-beg content-end) |
| 435 ) | |
| 436 (save-excursion | 481 (save-excursion |
| 437 (set-buffer buf) | 482 (set-buffer buf) |
| 438 (goto-char (point-min)) | 483 (goto-char (point-min)) |
| 439 (setq content-beg (point)) | 484 (setq content-beg (point)) |
| 440 (setq content-end (save-excursion (goto-char (point-max)) (point))) | 485 (setq content-end (save-excursion (goto-char (point-max)) (point))) |
| 441 (when (re-search-forward package-get-pgp-signed-begin-line nil t) | 486 (when (re-search-forward package-get-pgp-signed-begin-line nil t) |
| 442 ;(setq beg (match-beginning 0)) | |
| 443 (setq content-beg (match-end 0))) | 487 (setq content-beg (match-end 0))) |
| 444 (when (re-search-forward package-get-pgp-signature-begin-line nil t) | 488 (when (re-search-forward package-get-pgp-signature-begin-line nil t) |
| 445 (setq content-end (match-beginning 0)) | 489 (setq content-end (match-beginning 0)) |
| 446 (setq package-entries-are-signed t)) | 490 (setq package-entries-are-signed t)) |
| 447 (when (re-search-forward package-get-pgp-signature-end-line nil t) | 491 (re-search-forward package-get-pgp-signature-end-line nil t) |
| 448 ;(setq end (point)) | |
| 449 ) | |
| 450 (setq package-get-continue-update-base t) | 492 (setq package-get-continue-update-base t) |
| 451 (if package-get-require-signed-base-updates | 493 (if package-get-require-signed-base-updates |
| 452 (if package-entries-are-signed | 494 (if package-entries-are-signed |
| 453 (if (featurep 'mailcrypt-autoloads) | 495 (if (featurep 'mailcrypt-autoloads) |
| 454 (progn | 496 (progn |
| 475 (setq package-get-continue-update-base t)) | 517 (setq package-get-continue-update-base t)) |
| 476 (error 'unimplemented "`mailcrypt' package unavailable")) | 518 (error 'unimplemented "`mailcrypt' package unavailable")) |
| 477 (if (yes-or-no-p | 519 (if (yes-or-no-p |
| 478 "Package Index is not PGP signed. Continue anyway? ") | 520 "Package Index is not PGP signed. Continue anyway? ") |
| 479 (setq package-get-continue-update-base t) | 521 (setq package-get-continue-update-base t) |
| 480 (error "Package database not updated") | 522 (setq package-get-continue-update-base nil) |
| 481 (setq package-get-continue-update-base nil)))) | 523 (error "Package database not updated")))) |
| 482 ;; ToDo: We should call package-get-maybe-save-index on the region | 524 ;; ToDo: We should call package-get-maybe-save-index on the region |
| 483 (if package-get-continue-update-base | 525 (if package-get-continue-update-base |
| 484 (progn | 526 (progn |
| 485 (package-get-update-base-entries content-beg content-end) | 527 (package-get-update-base-entries content-beg content-end) |
| 486 (message "Updated package-get database")))))) | 528 (message "Updated package-get database")))))) |
| 561 (package-get-info-find-package package-get-base | 603 (package-get-info-find-package package-get-base |
| 562 package-symbol) nil) | 604 package-symbol) nil) |
| 563 'version)) | 605 'version)) |
| 564 (while (string= | 606 (while (string= |
| 565 (setq version (read-string "Version: " default-version)) | 607 (setq version (read-string "Version: " default-version)) |
| 566 "") | 608 "")) |
| 567 ) | |
| 568 (if package-symbol | 609 (if package-symbol |
| 569 (list package-symbol version) | 610 (list package-symbol version) |
| 570 (list package version)) | 611 (list package version))) |
| 571 ) | |
| 572 (if package-symbol | 612 (if package-symbol |
| 573 (list package-symbol) | 613 (list package-symbol) |
| 574 (list package)))))) | 614 (list package)))))) |
| 575 | 615 |
| 576 ;;;###autoload | 616 ;;;###autoload |
| 588 (package-get-require-base t) | 628 (package-get-require-base t) |
| 589 ;; Load a fresh copy | 629 ;; Load a fresh copy |
| 590 (catch 'exit | 630 (catch 'exit |
| 591 (mapcar (lambda (pkg) | 631 (mapcar (lambda (pkg) |
| 592 (if (not (package-get (car pkg) nil 'never)) | 632 (if (not (package-get (car pkg) nil 'never)) |
| 593 (throw 'exit nil) ;; Bail out if error detected | 633 (throw 'exit nil))) ;; Bail out if error detected |
| 594 )) | |
| 595 packages-package-list)) | 634 packages-package-list)) |
| 596 (package-net-update-installed-db)) | 635 (package-net-update-installed-db)) |
| 597 | 636 |
| 598 ;;;###autoload | 637 ;;;###autoload |
| 599 (defun package-get-all (package version &optional fetched-packages install-dir) | 638 (defun package-get-all (package version &optional fetched-packages install-dir) |
| 609 (interactive (package-get-interactive-package-query t nil)) | 648 (interactive (package-get-interactive-package-query t nil)) |
| 610 (let* ((the-package (package-get-info-find-package package-get-base | 649 (let* ((the-package (package-get-info-find-package package-get-base |
| 611 package)) | 650 package)) |
| 612 (this-package (package-get-info-version | 651 (this-package (package-get-info-version |
| 613 the-package version)) | 652 the-package version)) |
| 614 (this-requires (package-get-info-prop this-package 'requires)) | 653 (this-requires (package-get-info-prop this-package 'requires))) |
| 615 ) | |
| 616 (catch 'exit | 654 (catch 'exit |
| 617 (setq version (package-get-info-prop this-package 'version)) | 655 (setq version (package-get-info-prop this-package 'version)) |
| 618 (unless (package-get-installedp package version) | 656 (unless (package-get-installedp package version) |
| 619 (if (not (package-get package version nil install-dir)) | 657 (if (not (package-get package version nil install-dir)) |
| 620 (progn | 658 (progn |
| 639 (car this-requires))) | 677 (car this-requires))) |
| 640 (if (not (setq fetched-packages | 678 (if (not (setq fetched-packages |
| 641 (package-get-all reqd-name reqd-version | 679 (package-get-all reqd-name reqd-version |
| 642 fetched-packages | 680 fetched-packages |
| 643 install-dir))) | 681 install-dir))) |
| 644 (throw 'exit nil))) | 682 (throw 'exit nil)))) |
| 645 ) | 683 (setq this-requires (cdr this-requires)))) |
| 646 (setq this-requires (cdr this-requires))) | 684 fetched-packages)) |
| 647 ) | |
| 648 fetched-packages | |
| 649 )) | |
| 650 | 685 |
| 651 ;;;###autoload | 686 ;;;###autoload |
| 652 (defun package-get-dependencies (packages) | 687 (defun package-get-dependencies (packages) |
| 653 "Compute dependencies for PACKAGES. | 688 "Compute dependencies for PACKAGES. |
| 654 Uses `package-get-base' to determine just what is required and what | 689 Uses `package-get-base' to determine just what is required and what |
| 703 (if (and lispdir | 738 (if (and lispdir |
| 704 (file-accessible-directory-p lispdir)) | 739 (file-accessible-directory-p lispdir)) |
| 705 (progn | 740 (progn |
| 706 ;; Add lispdir to load-path if it doesn't already exist. | 741 ;; Add lispdir to load-path if it doesn't already exist. |
| 707 ;; NOTE: this does not take symlinks, etc., into account. | 742 ;; NOTE: this does not take symlinks, etc., into account. |
| 708 (if (let ( (dirs load-path) ) | 743 (if (let ((dirs load-path)) |
| 709 (catch 'done | 744 (catch 'done |
| 710 (while dirs | 745 (while dirs |
| 711 (if (string-equal (car dirs) lispdir) | 746 (if (string-equal (car dirs) lispdir) |
| 712 (throw 'done nil)) | 747 (throw 'done nil)) |
| 713 (setq dirs (cdr dirs)) | 748 (setq dirs (cdr dirs))) |
| 714 ) | |
| 715 t)) | 749 t)) |
| 716 (setq load-path (cons lispdir load-path))) | 750 (setq load-path (cons lispdir load-path))) |
| 717 (if (not (package-get-load-package-file lispdir "auto-autoloads")) | 751 (if (not (package-get-load-package-file lispdir "auto-autoloads")) |
| 718 (package-get-load-package-file lispdir "_pkg")) | 752 (package-get-load-package-file lispdir "_pkg")) |
| 719 t) | 753 t) |
| 720 nil) | 754 nil))) |
| 721 )) | 755 |
| 756 ;;;###autoload | |
| 757 (defun package-get-info (package information &optional arg remote) | |
| 758 "Get information about a package. | |
| 759 | |
| 760 Quite similar to `package-get-info-prop', but can retrieve a lot more | |
| 761 information. | |
| 762 | |
| 763 Argument PACKAGE is the name of an XEmacs package (a symbol). It must | |
| 764 be a valid package, ie, a member of `package-get-base'. | |
| 765 | |
| 766 Argument INFORMATION is a symbol that can be any one of: | |
| 767 | |
| 768 standards-version Package system version (not used). | |
| 769 version Version of the XEmacs package. | |
| 770 author-version The upstream version of the package. | |
| 771 date The date the package was last modified. | |
| 772 build-date The date the package was last built. | |
| 773 maintainer The maintainer of the package. | |
| 774 distribution Will always be \"xemacs\" (not used). | |
| 775 priority \"low\", \"medium\", or \"high\" (not used). | |
| 776 category Either \"standard\", \"mule\", or \"unsupported\".. | |
| 777 dump Is the package dumped (not used). | |
| 778 description A description of the package. | |
| 779 filename The filename of the binary tarball of the package. | |
| 780 md5sum The md5sum of filename. | |
| 781 size The size in bytes of filename. | |
| 782 provides A list of symbols that this package provides. | |
| 783 requires A list of packages that this package requires. | |
| 784 type Can be either \"regular\" or \"single-file\". | |
| 785 | |
| 786 If optional argument ARG is non-nil insert INFORMATION into current | |
| 787 buffer at point. This is very useful for doing things like inserting | |
| 788 a maintainer's email address into a mail buffer. | |
| 789 | |
| 790 If optional argument REMOTE is non-nil use a package list from a | |
| 791 remote site. For this to work `package-get-remote' must be non-nil. | |
| 792 | |
| 793 If this function is called interactively it will display INFORMATION | |
| 794 in the minibuffer." | |
| 795 (interactive "SPackage: \nSInfo: \nP") | |
| 796 (if remote | |
| 797 (package-get-require-base t) | |
| 798 (package-get-require-base nil)) | |
| 799 (let ((all-pkgs package-get-base) | |
| 800 info) | |
| 801 (loop until (equal package (caar all-pkgs)) | |
| 802 do (setq all-pkgs (cdr all-pkgs)) | |
| 803 do (if (not all-pkgs) | |
| 804 (error (format "%s is not a valid package" package)))) | |
| 805 (setq info (plist-get (cadar all-pkgs) information)) | |
| 806 (if (interactive-p) | |
| 807 (if arg | |
| 808 (insert (format "%s" info)) | |
| 809 (if (package-get-key package :version) | |
| 810 (message "%s" info) | |
| 811 (message "%s (Package: %s is not installed)" info package))) | |
| 812 (if arg | |
| 813 (insert (format "%s" info)) | |
| 814 info)))) | |
| 722 | 815 |
| 723 ;;;###autoload | 816 ;;;###autoload |
| 724 (defun package-get (package &optional version conflict install-dir) | 817 (defun package-get (package &optional version conflict install-dir) |
| 725 "Fetch PACKAGE from remote site. | 818 "Fetch PACKAGE from remote site. |
| 726 Optional arguments VERSION indicates which version to retrieve, nil | 819 Optional arguments VERSION indicates which version to retrieve, nil |
| 731 INSTALL-DIR, if non-nil, specifies the package directory where | 824 INSTALL-DIR, if non-nil, specifies the package directory where |
| 732 fetched packages should be installed. | 825 fetched packages should be installed. |
| 733 | 826 |
| 734 The value of `package-get-base' is used to determine what files should | 827 The value of `package-get-base' is used to determine what files should |
| 735 be retrieved. The value of `package-get-remote' is used to determine | 828 be retrieved. The value of `package-get-remote' is used to determine |
| 736 where a package should be retrieved from. The sites are tried in | 829 where a package should be retrieved from. |
| 737 order so one is better off listing easily reached sites first. | |
| 738 | 830 |
| 739 Once the package is retrieved, its md5 checksum is computed. If that | 831 Once the package is retrieved, its md5 checksum is computed. If that |
| 740 sum does not match that stored in `package-get-base' for this version | 832 sum does not match that stored in `package-get-base' for this version |
| 741 of the package, an error is signalled. | 833 of the package, an error is signalled. |
| 742 | 834 |
| 749 (package-get-info-version | 841 (package-get-info-version |
| 750 (package-get-info-find-package package-get-base | 842 (package-get-info-find-package package-get-base |
| 751 package) version)) | 843 package) version)) |
| 752 (latest (package-get-info-prop this-package 'version)) | 844 (latest (package-get-info-prop this-package 'version)) |
| 753 (installed (package-get-key package :version)) | 845 (installed (package-get-key package :version)) |
| 754 (this-requires (package-get-info-prop this-package 'requires)) | |
| 755 (found nil) | 846 (found nil) |
| 756 (search-dirs package-get-remote) | 847 (search-dir package-get-remote) |
| 757 (base-filename (package-get-info-prop this-package 'filename)) | 848 (base-filename (package-get-info-prop this-package 'filename)) |
| 758 (package-status t) | 849 (package-status t) |
| 759 filenames full-package-filename) | 850 filenames full-package-filename) |
| 851 (if (and (equal (package-get-info package 'category) "mule") | |
| 852 (not (featurep 'mule))) | |
| 853 (error "Mule package %s can't be installed with a non-Mule XEmacs" | |
| 854 package)) | |
| 760 (if (null this-package) | 855 (if (null this-package) |
| 761 (if package-get-remote | 856 (if package-get-remote |
| 762 (error "Couldn't find package %s with version %s" | 857 (error "Couldn't find package %s with version %s" |
| 763 package version) | 858 package version) |
| 764 (error "No download sites or local package locations specified."))) | 859 (error "No download site or local package location specified."))) |
| 765 (if (null base-filename) | 860 (if (null base-filename) |
| 766 (error "No filename associated with package %s, version %s" | 861 (error "No filename associated with package %s, version %s" |
| 767 package version)) | 862 package version)) |
| 768 (setq install-dir | 863 (setq install-dir |
| 769 (package-admin-get-install-dir package install-dir | 864 (package-admin-get-install-dir |
| 770 (or (eq package 'mule-base) (memq 'mule-base this-requires)))) | 865 package install-dir |
| 866 (equal (package-get-info package 'category) "mule"))) | |
| 771 | 867 |
| 772 ;; If they asked for the latest using version=nil, don't get an older | 868 ;; If they asked for the latest using version=nil, don't get an older |
| 773 ;; version than we already have. | 869 ;; version than we already have. |
| 774 (if installed | 870 (if installed |
| 775 (if (> (if (stringp installed) | 871 (if (> (if (stringp installed) |
| 798 (package-get-installedp package version)) | 894 (package-get-installedp package version)) |
| 799 ;; Find the package from the search list in package-get-remote | 895 ;; Find the package from the search list in package-get-remote |
| 800 ;; and copy it into the staging directory. Then validate | 896 ;; and copy it into the staging directory. Then validate |
| 801 ;; the checksum. Finally, install the package. | 897 ;; the checksum. Finally, install the package. |
| 802 (catch 'done | 898 (catch 'done |
| 803 (let (search-filenames current-dir-entry host dir current-filename | 899 (let (search-filenames host dir current-filename dest-filename) |
| 804 dest-filename) | |
| 805 ;; In each search directory ... | 900 ;; In each search directory ... |
| 806 (while search-dirs | 901 (when search-dir |
| 807 (setq current-dir-entry (car search-dirs) | 902 (setq host (car search-dir) |
| 808 host (car current-dir-entry) | 903 dir (car (cdr search-dir)) |
| 809 dir (car (cdr current-dir-entry)) | 904 search-filenames filenames) |
| 810 search-filenames filenames | |
| 811 ) | |
| 812 | 905 |
| 813 ;; Look for one of the possible package filenames ... | 906 ;; Look for one of the possible package filenames ... |
| 814 (while search-filenames | 907 (while search-filenames |
| 815 (setq current-filename (car search-filenames) | 908 (setq current-filename (car search-filenames) |
| 816 dest-filename (package-get-staging-dir current-filename)) | 909 dest-filename (package-get-staging-dir current-filename)) |
| 817 (cond | 910 (cond |
| 818 ;; No host means look on the current system. | 911 ;; No host means look on the current system. |
| 819 ( (null host) | 912 ((null host) |
| 820 (setq full-package-filename | 913 (setq full-package-filename |
| 821 (substitute-in-file-name | 914 (substitute-in-file-name |
| 822 (expand-file-name current-filename | 915 (expand-file-name current-filename |
| 823 (file-name-as-directory dir)))) | 916 (file-name-as-directory dir))))) |
| 824 ) | |
| 825 | 917 |
| 826 ;; If it's already on the disk locally, and the size is | 918 ;; If it's already on the disk locally, and the size is |
| 827 ;; greater than zero ... | 919 ;; correct |
| 828 ( (and (file-exists-p dest-filename) | 920 ((and (file-exists-p dest-filename) |
| 829 (let (attrs) | 921 (eq (nth 7 (file-attributes dest-filename)) |
| 830 ;; file-attributes could return -1 for LARGE files, | 922 (package-get-info package 'size))) |
| 831 ;; but, hopefully, packages won't be that large. | 923 (setq full-package-filename dest-filename)) |
| 832 (and (setq attrs (file-attributes dest-filename)) | |
| 833 (> (nth 7 attrs) 0)))) | |
| 834 (setq full-package-filename dest-filename) | |
| 835 ) | |
| 836 | 924 |
| 837 ;; If the file exists on the remote system ... | 925 ;; If the file exists on the remote system ... |
| 838 ( (file-exists-p (package-get-remote-filename | 926 ((file-exists-p (package-get-remote-filename |
| 839 current-dir-entry current-filename)) | 927 search-dir current-filename)) |
| 840 ;; Get it | 928 ;; Get it |
| 841 (setq full-package-filename dest-filename) | 929 (setq full-package-filename dest-filename) |
| 842 (message "Retrieving package `%s' ..." | 930 (message "Retrieving package `%s' ..." |
| 843 current-filename) | 931 current-filename) |
| 844 (sit-for 0) | 932 (sit-for 0) |
| 845 (copy-file (package-get-remote-filename current-dir-entry | 933 (copy-file (package-get-remote-filename search-dir |
| 846 current-filename) | 934 current-filename) |
| 847 full-package-filename t) | 935 full-package-filename t))) |
| 848 ) | |
| 849 ) | |
| 850 | 936 |
| 851 ;; If we found it, we're done. | 937 ;; If we found it, we're done. |
| 852 (if (and full-package-filename | 938 (if (and full-package-filename |
| 853 (file-exists-p full-package-filename)) | 939 (file-exists-p full-package-filename)) |
| 854 (throw 'done nil)) | 940 (throw 'done nil)) |
| 855 ;; Didn't find it. Try the next possible filename. | 941 ;; Didn't find it. Try the next possible filename. |
| 856 (setq search-filenames (cdr search-filenames)) | 942 (setq search-filenames (cdr search-filenames)))))) |
| 857 ) | |
| 858 ;; Try looking in the next possible directory ... | |
| 859 (setq search-dirs (cdr search-dirs)) | |
| 860 ) | |
| 861 )) | |
| 862 | 943 |
| 863 (if (or (not full-package-filename) | 944 (if (or (not full-package-filename) |
| 864 (not (file-exists-p full-package-filename))) | 945 (not (file-exists-p full-package-filename))) |
| 865 (if package-get-remote | 946 (if package-get-remote |
| 866 (error "Unable to find file %s" base-filename) | 947 (error "Unable to find file %s" base-filename) |
| 872 (with-temp-buffer | 953 (with-temp-buffer |
| 873 (insert-file-contents-literally full-package-filename) | 954 (insert-file-contents-literally full-package-filename) |
| 874 (if (not (string= (md5 (current-buffer)) | 955 (if (not (string= (md5 (current-buffer)) |
| 875 (package-get-info-prop this-package | 956 (package-get-info-prop this-package |
| 876 'md5sum))) | 957 'md5sum))) |
| 877 (error "Package %s does not match md5 checksum" base-filename))) | 958 (progn |
| 959 (delete-file full-package-filename) | |
| 960 (error "Package %s does not match md5 checksum %s has been deleted" | |
| 961 base-filename full-package-filename)))) | |
| 878 | 962 |
| 879 (package-admin-delete-binary-package package install-dir) | 963 (package-admin-delete-binary-package package install-dir) |
| 880 | 964 |
| 881 (message "Installing package `%s' ..." package) (sit-for 0) | 965 (message "Installing package `%s' ..." package) (sit-for 0) |
| 882 (let ((status | 966 (let ((status |
| 890 (if (package-get-init-package (package-admin-get-lispdir | 974 (if (package-get-init-package (package-admin-get-lispdir |
| 891 install-dir package)) | 975 install-dir package)) |
| 892 (progn | 976 (progn |
| 893 (run-hook-with-args 'package-install-hook package install-dir) | 977 (run-hook-with-args 'package-install-hook package install-dir) |
| 894 (message "Added package `%s'" package) | 978 (message "Added package `%s'" package) |
| 895 (sit-for 0) | 979 (sit-for 0)) |
| 896 ) | |
| 897 (progn | 980 (progn |
| 898 ;; display message only if there isn't already one. | 981 ;; display message only if there isn't already one. |
| 899 (if (not (current-message)) | 982 (if (not (current-message)) |
| 900 (progn | 983 (progn |
| 901 (message "Added package `%s' (errors occurred)" | 984 (message "Added package `%s' (errors occurred)" |
| 902 package) | 985 package) |
| 903 (sit-for 0) | 986 (sit-for 0))) |
| 904 )) | |
| 905 (if package-status | 987 (if package-status |
| 906 (setq package-status 'errors)) | 988 (setq package-status 'errors))))) |
| 907 )) | |
| 908 ) | |
| 909 (message "Installation of package %s failed." base-filename) | 989 (message "Installation of package %s failed." base-filename) |
| 910 (sit-for 0) | 990 (sit-for 0) |
| 911 (switch-to-buffer package-admin-temp-buffer) | 991 (switch-to-buffer package-admin-temp-buffer) |
| 912 (setq package-status nil) | 992 (delete-file full-package-filename) |
| 913 )) | 993 (setq package-status nil))) |
| 914 (setq found t)) | 994 (setq found t)) |
| 915 (if (and found package-get-remove-copy) | 995 (if (and found package-get-remove-copy) |
| 916 (delete-file full-package-filename)) | 996 (delete-file full-package-filename)) |
| 917 package-status | 997 package-status))) |
| 918 ))) | |
| 919 | 998 |
| 920 (defun package-get-info-find-package (which name) | 999 (defun package-get-info-find-package (which name) |
| 921 "Look in WHICH for the package called NAME and return all the info | 1000 "Look in WHICH for the package called NAME and return all the info |
| 922 associated with it. See `package-get-base' for info on the format | 1001 associated with it. See `package-get-base' for info on the format |
| 923 returned. | 1002 returned. |
| 963 "In PACKAGE-LIST, search for PACKAGE with this VERSION and return | 1042 "In PACKAGE-LIST, search for PACKAGE with this VERSION and return |
| 964 PROPERTY value." | 1043 PROPERTY value." |
| 965 (package-get-info-prop | 1044 (package-get-info-prop |
| 966 (package-get-info-version | 1045 (package-get-info-version |
| 967 (package-get-info-find-package package-list package) version) property)) | 1046 (package-get-info-find-package package-list package) version) property)) |
| 968 | |
| 969 (defun package-get-set-version-prop (package-list package version | |
| 970 property value) | |
| 971 "A utility to make it easier to add a VALUE for a specific PROPERTY | |
| 972 in this VERSION of a specific PACKAGE kept in the PACKAGE-LIST. | |
| 973 Returns the modified PACKAGE-LIST. Any missing fields are created." | |
| 974 ) | |
| 975 | 1047 |
| 976 (defun package-get-staging-dir (filename) | 1048 (defun package-get-staging-dir (filename) |
| 977 "Return a good place to stash FILENAME when it is retrieved. | 1049 "Return a good place to stash FILENAME when it is retrieved. |
| 978 Use `package-get-dir' for directory to store stuff. | 1050 Use `package-get-dir' for directory to store stuff. |
| 979 Creates `package-get-dir' if it doesn't exist." | 1051 Creates `package-get-dir' if it doesn't exist." |
| 1008 (if (string-match "/$" dir) | 1080 (if (string-match "/$" dir) |
| 1009 dir | 1081 dir |
| 1010 (concat dir "/")) | 1082 (concat dir "/")) |
| 1011 filename)))) | 1083 filename)))) |
| 1012 | 1084 |
| 1013 | |
| 1014 (defun package-get-installedp (package version) | 1085 (defun package-get-installedp (package version) |
| 1015 "Determine if PACKAGE with VERSION has already been installed. | 1086 "Determine if PACKAGE with VERSION has already been installed. |
| 1016 I'm not sure if I want to do this by searching directories or checking | 1087 I'm not sure if I want to do this by searching directories or checking |
| 1017 some built in variables. For now, use packages-package-list." | 1088 some built in variables. For now, use packages-package-list." |
| 1018 ;; Use packages-package-list which contains name and version | 1089 ;; Use packages-package-list which contains name and version |
| 1019 (equal (plist-get | 1090 (equal (plist-get |
| 1020 (package-get-info-find-package packages-package-list | 1091 (package-get-info-find-package packages-package-list |
| 1021 package) ':version) | 1092 package) ':version) |
| 1022 (if (floatp version) version (string-to-number version)))) | 1093 (if (floatp version) |
| 1094 version | |
| 1095 (string-to-number version)))) | |
| 1023 | 1096 |
| 1024 ;;;###autoload | 1097 ;;;###autoload |
| 1025 (defun package-get-package-provider (sym &optional force-current) | 1098 (defun package-get-package-provider (sym &optional force-current) |
| 1026 "Search for a package that provides SYM and return the name and | 1099 "Search for a package that provides SYM and return the name and |
| 1027 version. Searches in `package-get-base' for SYM. If SYM is a | 1100 version. Searches in `package-get-base' for SYM. If SYM is a |
| 1064 (if (package-get-info-find-package | 1137 (if (package-get-info-find-package |
| 1065 packages-package-list | 1138 packages-package-list |
| 1066 (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) | 1139 (intern (substring (symbol-name pkg) 0 (match-beginning 0)))) |
| 1067 t))) | 1140 t))) |
| 1068 | 1141 |
| 1069 | |
| 1070 (provide 'package-get) | 1142 (provide 'package-get) |
| 1071 ;;; package-get.el ends here | 1143 ;;; package-get.el ends here |