annotate lisp/package-get.el @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents a6c89d799f00
children 8e8a7b205142
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; package-get.el --- Retrieve XEmacs package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1998 by Pete Ware
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Author: Pete Ware <ware@cis.ohio-state.edu>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 ;; Heavy-Modifications: Greg Klanderman <greg@alphatech.com>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 ;; Jan Vroonhof <vroonhof@math.ethz.ch>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Keywords: internal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 ;;; Synched up with: Not in FSF
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31 ;; package-get -
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; Retrieve a package and any other required packages from an archive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
35 ;; Note (JV): Most of this no longer applies!
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; The idea:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 ;; A new XEmacs lisp-only release is generated with the following steps:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;; 1. The maintainer runs some yet to be written program that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 ;; generates all the dependency information. This should
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 ;; determine all the require and provide statements and associate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;; them with a package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 ;; 2. All the packages are then bundled into their own tar balls
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 ;; (or whatever format)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 ;; 3. Maintainer automatically generates a new `package-get-base'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 ;; data structure which contains information such as the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 ;; package name, the file to be retrieved, an md5 checksum,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 ;; etc (see `package-get-base').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 ;; 4. The maintainer posts an announcement with the new version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 ;; of `package-get-base'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 ;; 5. A user/system manager saves this posting and runs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ;; `package-get-update' which uses the previously saved list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 ;; of packages, `package-get-here' that the user/site
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 ;; wants to determine what new versions to download and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 ;; install.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 ;; A user/site manager can generate a new `package-get-here' structure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 ;; by using `package-get-setup' which generates a customize like
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 ;; interface to the list of packages. The buffer looks something
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 ;; like:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 ;; gnus - a mail and news reader
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 ;; [] Always install
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 ;; [] Needs updating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 ;; [] Required by other [packages]
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 ;; version: 2.0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ;; vm - a mail reader
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 ;; [] Always install
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 ;; [] Needs updating
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
71 ;; [] Required by other [packages]
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 ;; Where `[]' indicates a toggle box
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 ;; - Clicking on "Always install" puts this into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;; `package-get-here' list. "Needs updating" indicates a new
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; version is available. Anything already in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 ;; `package-get-here' has this enabled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;; - "Required by other" means some other packages are going to force
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 ;; this to be installed. Clicking on [packages] gives a list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;; of packages that require this.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
82 ;;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 ;; The `package-get-base' should be installed in a file in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;; `data-directory'. The `package-get-here' should be installed in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 ;; site-lisp. Both are then read at run time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 ;; TODO:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;; - Implement `package-get-setup'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; - Actually put `package-get-base' and `package-get-here' into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 ;; files that are read.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; - Allow users to have their own packages that they want installed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 ;; in ~/.xemacs/.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 ;; - SOMEONE needs to write the programs that generate the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 ;; provides/requires database and makes it into a lisp data
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ;; structure suitable for `package-get-base'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 ;; - Handle errors such as no package providing a required symbol.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 ;; - Tie this into the `require' function to download packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 ;; transparently.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;;; Change Log
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (require 'package-admin)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 ;; (require 'package-get-base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 (defgroup package-tools nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 "Tools to manipulate packages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 (defgroup package-get nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 "Automatic Package Fetcher and Installer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 :prefix "package-get"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 :group 'package-tools)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
116 ;;;###autoload
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 (defvar package-get-base nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 "List of packages that are installed at this site.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 For each element in the alist, car is the package name and the cdr is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 a plist containing information about the package. Typical fields
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 kept in the plist are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 version - version of this package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 provides - list of symbols provided
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 requires - list of symbols that are required.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 These in turn are provided by other packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 filename - name of the file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 size - size of the file (aka the bundled package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 md5sum - computed md5 checksum
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 description - What this package is for.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 type - Whether this is a 'binary (default) or 'single file package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 More fields may be added as needed. An example:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 '(
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 (name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 (version \"<version 2>\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 file \"filename\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 description \"what this package is about.\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 provides (<list>)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 requires (<list>)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 size <integer-bytes>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 md5sum \"<checksum\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 type single
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 (version \"<version 1>\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 file \"filename\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 description \"what this package is about.\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 provides (<list>)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 requires (<list>)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 size <integer-bytes>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 md5sum \"<checksum\"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 type single
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 For version information, it is assumed things are listed in most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 recent to least recent -- in other words, the version names don't have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 be lexically ordered. It is debatable if it makes sense to have more than
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 one version of a package available.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (defcustom package-get-dir (temp-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 "*Where to store temporary files for staging."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 :tag "Temporary directory"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 :type 'directory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 (define-widget 'host-name 'string
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 "A Host name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 :tag "Host")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (defcustom package-get-remote nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 "*List of remote sites to contact for downloading packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 List format is '(site-name directory-on-site). Each site is tried in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 order until the package is found. As a special case, `site-name' can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 `nil', in which case `directory-on-site' is treated as a local directory."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 :tag "Package repository"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 :type '(repeat (choice (list :tag "Local" (const :tag "Local" nil) directory )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 (list :tag "Remote" host-name directory) ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 (defcustom package-get-download-sites
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 '(
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 ;; North America
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
187 ("Pre-Releases" "ftp.xemacs.org" "pub/xemacs/beta/experimental/packages")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 ("xemacs.org" "ftp.xemacs.org" "pub/xemacs/packages")
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
189 ("crc.ca (Canada)" "ftp.crc.ca" "pub/packages/editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
190 ("ualberta.ca (Canada)" "sunsite.ualberta.ca" "pub/Mirror/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
191 ("uiuc.edu (United States)" "uiarchive.uiuc.edu" "pub/packages/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
192 ("unc.edu (United States)" "metalab.unc.edu" "pub/packages/editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
193 ("utk.edu (United States)" "ftp.sunsite.utk.edu" "pub/xemacs/packages")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 ;; South America
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
196 ("unicamp.br (Brazil)" "ftp.unicamp.br" "pub/xemacs/packages")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 ;; Europe
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
199 ("tuwien.ac.at (Austria)" "gd.tuwien.ac.at" "editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
200 ("auc.dk (Denmark)" "sunsite.auc.dk" "pub/emacs/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
201 ("doc.ic.ac.uk (England)" "sunsite.doc.ic.ac.uk" "packages/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
202 ("funet.fi (Finland)" "ftp.funet.fi" "pub/mirrors/ftp.xemacs.org/pub/tux/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
203 ("cenatls.cena.dgac.fr (France)" "ftp.cenatls.cena.dgac.fr" "Emacs/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
204 ("pasteur.fr (France)" "ftp.pasteur.fr" "pub/computing/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
205 ("tu-darmstadt.de (Germany)" "ftp.tu-darmstadt.de" "pub/editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
206 ("kfki.hu (Hungary)" "ftp.kfki.hu" "pub/packages/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
207 ("eunet.ie (Ireland)" "ftp.eunet.ie" "mirrors/ftp.xemacs.org/pub/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
208 ("uniroma2.it (Italy)" "ftp.uniroma2.it" "unix/misc/dist/XEMACS/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
209 ("uio.no (Norway)" "sunsite.uio.no" "pub/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
210 ("icm.edu.pl (Poland)" "ftp.icm.edu.pl" "pub/unix/editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
211 ("srcc.msu.su (Russia)" "ftp.srcc.msu.su" "mirror/ftp.xemacs.org/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
212 ("sunet.se (Sweden)" "ftp.sunet.se" "pub/gnu/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
213 ("cnlab-switch.ch (Switzerland)" "sunsite.cnlab-switch.ch" "mirror/xemacs/packages")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 ;; Asia
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
216 ("aist.go.jp (Japan)" "ring.aist.go.jp" "pub/text/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
217 ("asahi-net.or.jp (Japan)" "ring.asahi-net.or.jp" "pub/text/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
218 ("dti.ad.jp (Japan)" "ftp.dti.ad.jp" "pub/unix/editor/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
219 ("jaist.ac.jp (Japan)" "ftp.jaist.ac.jp" "pub/GNU/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
220 ("nucba.ac.jp (Japan)" "mirror.nucba.ac.jp" "mirror/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
221 ("sut.ac.jp (Japan)" "sunsite.sut.ac.jp" "pub/archives/packages/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
222 ("tsukuba.ac.jp (Japan)" "ftp.netlab.is.tsukuba.ac.jp" "pub/GNU/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
223 ("kreonet.re.kr (Korea)" "ftp.kreonet.re.kr" "pub/tools/emacs/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
224 ("nctu.edu.tw (Taiwan)" "coda.nctu.edu.tw" "Editors/xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
225
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
226 ;; Africa
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
227 ("sun.ac.za (South Africa)" "ftp.sun.ac.za" "xemacs/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
228
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
229 ;; Middle East
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
230 ("isu.net.sa (Saudi Arabia)" "ftp.isu.net.sa" "pub/mirrors/ftp.xemacs.org/packages")
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
231
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
232 ;; Australia
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
233 ("aarnet.edu.au (Australia)" "mirror.aarnet.edu.au" "pub/xemacs/packages")
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 "*List of remote sites available for downloading packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 List format is '(site-description site-name directory-on-site).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 SITE-DESCRIPTION is a textual description of the site. SITE-NAME
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 is the internet address of the download site. DIRECTORY-ON-SITE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 is the directory on the site in which packages may be found.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 This variable is used to initialize `package-get-remote', the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 variable actually used to specify package download sites."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 :tag "Package download sites"
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
243 :type '(repeat (list (string :tag "Name") host-name directory))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 (defcustom package-get-remove-copy t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 "*After copying and installing a package, if this is t, then remove the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 copy. Otherwise, keep it around."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 ;; #### it may make sense for this to be a list of names.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 ;; #### also, should we rename "*base*" to "*index*" or "*db*"?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 ;; "base" is a pretty poor name.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 (defcustom package-get-base-filename "package-index.LATEST.pgp"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 "*Name of the default package-get database file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 This may either be a relative path, in which case it is interpreted
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 with respect to `package-get-remote', or an absolute path."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 :type 'file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (defvar package-get-user-index-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 (paths-construct-path (list user-init-directory package-get-base-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 "Name for the user-specific location of the package-get database file.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 (defcustom package-get-always-update nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 "*If Non-nil always make sure we are using the latest package index (base).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 Otherwise respect the `force-current' argument of `package-get-require-base'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
272 (defcustom package-get-require-signed-base-updates nil
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 "*If set to a non-nil value, require explicit user confirmation for updates
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 to the package-get database which cannot have their signature verified via PGP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 When nil, updates which are not PGP signed are allowed without confirmation."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 :type 'boolean
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 :group 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 (defvar package-get-was-current nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 "Non-nil we did our best to fetch a current database.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 ;Shouldn't this be in package-ui?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 (defun package-get-download-menu ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 "Build the `Add Download Site' menu."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 (mapcar (lambda (site)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 (vector (car site)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 `(if (member (quote ,(cdr site))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 package-get-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 (setq package-get-remote
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
292 (delete (quote ,(cdr site))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
293 package-get-remote))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 (package-ui-add-site (quote ,(cdr site))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 :style 'toggle
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 :selected `(member (quote ,(cdr site))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 package-get-remote)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 package-get-download-sites))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 (defun package-get-require-base (&optional force-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 "Require that a package-get database has been loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 If the optional FORCE-CURRENT argument or the value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 `package-get-always-update' is Non-nil, try to update the database
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 from a location in `package-get-remote'. Otherwise a local copy is used
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 if available and remote access is never done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 Please use FORCE-CURRENT only when the user is explictly dealing with packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 and remote access is likely in the near future."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 (setq force-current (or force-current package-get-always-update))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 (unless (and (boundp 'package-get-base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 package-get-base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (or (not force-current) package-get-was-current))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 (package-get-update-base nil force-current))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 (if (or (not (boundp 'package-get-base))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 (not package-get-base))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (error "Package-get database not loaded")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 (setq package-get-was-current force-current)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 (defconst package-get-pgp-signed-begin-line "^-----BEGIN PGP SIGNED MESSAGE-----"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 "Text for start of PGP signed messages.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 (defconst package-get-pgp-signature-begin-line "^-----BEGIN PGP SIGNATURE-----"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 "Text for beginning of PGP signature.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 (defconst package-get-pgp-signature-end-line "^-----END PGP SIGNATURE-----"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 "Text for end of PGP signature.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 (defun package-get-update-base-entry (entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 "Update an entry in `package-get-base'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 (let ((existing (assq (car entry) package-get-base)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 (if existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 (setcdr existing (cdr entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 (setq package-get-base (cons entry package-get-base))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 (package-get-custom-add-entry (car entry) (car (cdr entry))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (defun package-get-locate-file (file &optional nil-if-not-found no-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 "Locate an existing FILE with respect to `package-get-remote'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 If FILE is an absolute path or is not found, simply return FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 If optional argument NIL-IF-NOT-FOUND is non-nil, return nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 if FILE can not be located.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 If NO-REMOTE is non-nil never search remote locations."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (if (file-name-absolute-p file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 (let ((entries package-get-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 (expanded nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 (while entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (unless (and no-remote (caar entries))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (let ((expn (package-get-remote-filename (car entries) file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (if (and expn (file-exists-p expn))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (setq entries nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 expanded expn))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 (setq entries (cdr entries)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 (or expanded
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 (and (not nil-if-not-found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 file)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 (defun package-get-locate-index-file (no-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 "Locate the package-get index file. Do not return remote paths if NO-REMOTE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 is non-nil."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 (or (package-get-locate-file package-get-base-filename t no-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 (if (file-exists-p package-get-user-index-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 package-get-user-index-filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 (defun package-get-maybe-save-index (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 "Offer to save the current buffer as the local package index file,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 if different."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 (let ((location (package-get-locate-index-file t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 (unless (and filename (equal filename location))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 (unless (and location
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 (equal (md5 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 (with-temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 (insert-file-contents-literally location)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 (md5 (current-buffer)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 (unless (and location (file-writable-p location))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 (setq location package-get-user-index-filename))
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
376 (when (y-or-n-p (concat "Update package index in " location "? "))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
377 (let ((coding-system-for-write 'binary))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
378 (write-file location)))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 (defun package-get-update-base (&optional db-file force-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 "Update the package-get database file with entries from DB-FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 Unless FORCE-CURRENT is non-nil never try to update the database."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 (interactive
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 (let ((dflt (package-get-locate-index-file nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 (list (read-file-name "Load package-get database: "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 (file-name-directory dflt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 dflt
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 (file-name-nondirectory dflt)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 (setq db-file (expand-file-name (or db-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 (package-get-locate-index-file
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 (not force-current)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 (if (not (file-exists-p db-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (error "Package-get database file `%s' does not exist" db-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 (if (not (file-readable-p db-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 (error "Package-get database file `%s' not readable" db-file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (let ((buf (get-buffer-create "*package database*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (erase-buffer buf)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
404 (insert-file-contents-literally db-file)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (package-get-update-base-from-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (if (file-remote-p db-file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 (package-get-maybe-save-index db-file)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (kill-buffer buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (defun package-get-update-base-from-buffer (&optional buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 "Update the package-get database with entries from BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 BUFFER defaults to the current buffer. This command can be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 used interactively, for example from a mail or news buffer."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 (setq buf (or buf (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 (let (content-beg content-end beg end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 (setq content-beg (point))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 (setq content-end (save-excursion (goto-char (point-max)) (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (when (re-search-forward package-get-pgp-signed-begin-line nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 (setq beg (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 (setq content-beg (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (when (re-search-forward package-get-pgp-signature-begin-line nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 (setq content-end (match-beginning 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 (when (re-search-forward package-get-pgp-signature-end-line nil t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 (setq end (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 (if (not (and content-beg content-end beg end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 (or (not package-get-require-signed-base-updates)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (yes-or-no-p "Package-get entries not PGP signed, continue? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (error "Package-get database not updated")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (if (and content-beg content-end beg end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (if (not (condition-case nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 (or (fboundp 'mc-pgp-verify-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (load-library "mc-pgp")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (fboundp 'mc-pgp-verify-region))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (error nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 (or (not package-get-require-signed-base-updates)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "No mailcrypt; can't verify package-get DB signature, continue? ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 (error "Package-get database not updated"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 (if (and beg end
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 (fboundp 'mc-pgp-verify-region)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (or (not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 (condition-case err
502
7039e6323819 [xemacs-hg @ 2001-05-04 22:41:46 by ben]
ben
parents: 454
diff changeset
448 (declare-fboundp (mc-pgp-verify-region beg end))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 (file-error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 (and (string-match "No such file" (nth 2 err))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 (or (not package-get-require-signed-base-updates)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 (yes-or-no-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (concat "Can't find PGP, continue without "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 "package-get DB verification? ")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 (t nil)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (error "Package-get PGP signature failed to verify"))
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
457 ;; ToDo: We should call package-get-maybe-save-index on the region
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (package-get-update-base-entries content-beg content-end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (message "Updated package-get database"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
461 (defun package-get-update-base-entries (start end)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 "Update the package-get database with the entries found between
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
463 START and END in the current buffer."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (save-excursion
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
465 (goto-char start)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (if (not (re-search-forward "^(package-get-update-base-entry" nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 (error "Buffer does not contain package-get database entries"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 (let ((count 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 (while (and (< (point) end)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (re-search-forward "^(package-get-update-base-entry" nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 (beginning-of-line)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (let ((entry (read (current-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (if (or (not (consp entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (not (eq (car entry) 'package-get-update-base-entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 (error "Invalid package-get database entry found"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (package-get-update-base-entry
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (car (cdr (car (cdr entry)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 (setq count (1+ count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 (message "Got %d package-get database entries" count))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 (defun package-get-save-base (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 "Write the package-get database to FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 Note: This database will be unsigned of course."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 (interactive "FSave package-get database to: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 (package-get-require-base t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 (let ((buf (get-buffer-create "*package database*")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 (save-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (set-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (erase-buffer buf)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (goto-char (point-min))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (let ((entries package-get-base) entry plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 (insert ";; Package Index file -- Do not edit manually.\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 (insert ";;;@@@\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 (while entries
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (setq entry (car entries))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (setq plist (car (cdr entry)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (insert "(package-get-update-base-entry (quote\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (insert (format "(%s\n" (symbol-name (car entry))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 (while plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 (insert (format " %s%s %S\n"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 (if (eq plist (car (cdr entry))) "(" " ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (symbol-name (car plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (car (cdr plist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 (setq plist (cdr (cdr plist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 (insert "))\n))\n;;;@@@\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 (setq entries (cdr entries))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (insert ";; Package Index file ends here\n")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 (write-region (point-min) (point-max) file))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 (kill-buffer buf))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 (defun package-get-interactive-package-query (get-version package-symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516 "Perform interactive querying for package and optional version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 Query for a version if GET-VERSION is non-nil. Return package name as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 a symbol instead of a string if PACKAGE-SYMBOL is non-nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 The return value is suitable for direct passing to `interactive'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 (package-get-require-base t)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
521 (let ((table (mapcar #'(lambda (item)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
522 (let ((name (symbol-name (car item))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
523 (cons name name)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
524 package-get-base))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
525 package package-symbol default-version version)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (save-window-excursion
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 (setq package (completing-read "Package: " table nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (setq package-symbol (intern package))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 (if get-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 (progn
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
531 (setq default-version
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
532 (package-get-info-prop
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 (package-get-info-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 (package-get-info-find-package package-get-base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 package-symbol) nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 'version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 (while (string=
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 (setq version (read-string "Version: " default-version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 (if package-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (list package-symbol version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 (list package version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 (if package-symbol
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (list package-symbol)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
547 (list package))))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (defun package-get-delete-package (package &optional pkg-topdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 "Delete an installation of PACKAGE below directory PKG-TOPDIR.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 PACKAGE is a symbol, not a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553 This is just an interactive wrapper for `package-admin-delete-binary-package'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (interactive (package-get-interactive-package-query nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 (package-admin-delete-binary-package package pkg-topdir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 (defun package-get-update-all ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 "Fetch and install the latest versions of all currently installed packages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 (package-get-require-base t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 ;; Load a fresh copy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 (catch 'exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 (mapcar (lambda (pkg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (if (not (package-get (car pkg) nil 'never))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (throw 'exit nil) ;; Bail out if error detected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 packages-package-list)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 (defun package-get-all (package version &optional fetched-packages install-dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 "Fetch PACKAGE with VERSION and all other required packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 Uses `package-get-base' to determine just what is required and what
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
574 package provides that functionality. If VERSION is nil, retrieves
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 latest version. Optional argument FETCHED-PACKAGES is used to keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 track of packages already fetched. Optional argument INSTALL-DIR,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 if non-nil, specifies the package directory where fetched packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 should be installed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 Returns nil upon error."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 (interactive (package-get-interactive-package-query t nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 (let* ((the-package (package-get-info-find-package package-get-base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 package))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 (this-package (package-get-info-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 the-package version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 (this-requires (package-get-info-prop this-package 'requires))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 (catch 'exit
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 (setq version (package-get-info-prop this-package 'version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 (unless (package-get-installedp package version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 (if (not (package-get package version nil install-dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 (setq fetched-packages nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 (throw 'exit nil))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 (setq fetched-packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 (append (list package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 (package-get-info-prop this-package 'provides)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 fetched-packages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 ;; grab everything that this package requires plus recursively
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 ;; grab everything that the requires require. Keep track
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 ;; in `fetched-packages' the list of things provided -- this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 ;; keeps us from going into a loop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 (while this-requires
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604 (if (not (member (car this-requires) fetched-packages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 (let* ((reqd-package (package-get-package-provider
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606 (car this-requires) t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 (reqd-version (cadr reqd-package))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 (reqd-name (car reqd-package)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 (if (null reqd-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 (error "Unable to find a provider for %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 (car this-requires)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 (if (not (setq fetched-packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 (package-get-all reqd-name reqd-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 fetched-packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 install-dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
616 (throw 'exit nil)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 (setq this-requires (cdr this-requires)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 fetched-packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 (defun package-get-dependencies (packages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 "Compute dependencies for PACKAGES.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 Uses `package-get-base' to determine just what is required and what
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 package provides that functionality. Returns the list of packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 required by PACKAGES."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 (package-get-require-base t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 (let ((orig-packages packages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 dependencies provided)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 (while packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 (let* ((package (car packages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 (the-package (package-get-info-find-package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 package-get-base package))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636 (this-package (package-get-info-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 the-package nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
638 (this-requires (package-get-info-prop this-package 'requires))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 (new-depends (set-difference
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
640 (mapcar
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 #'(lambda (reqd)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 (let* ((reqd-package (package-get-package-provider reqd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 (reqd-name (car reqd-package)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 (if (null reqd-name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645 (error "Unable to find a provider for %s" reqd))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 reqd-name))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 this-requires)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 dependencies))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 (this-provides (package-get-info-prop this-package 'provides)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 (setq dependencies
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 (union dependencies new-depends))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652 (setq provided
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 (union provided (union (list package) this-provides)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 (setq packages
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 (union new-depends (cdr packages)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 (set-difference dependencies orig-packages)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 (defun package-get-load-package-file (lispdir file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 (let (pathname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 (setq pathname (expand-file-name file lispdir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 (condition-case err
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663 (load pathname t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 (message "Error loading package file \"%s\" %s!" pathname err)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 (defun package-get-init-package (lispdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 "Initialize the package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672 This really assumes that the package has never been loaded. Updating
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 a newer package can cause problems, due to old, obsolete functions in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 the old package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 Return `t' upon complete success, `nil' if any errors occurred."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 (if (and lispdir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 (file-accessible-directory-p lispdir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 ;; Add lispdir to load-path if it doesn't already exist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 ;; NOTE: this does not take symlinks, etc., into account.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 (if (let ( (dirs load-path) )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 (catch 'done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 (while dirs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 (if (string-equal (car dirs) lispdir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 (throw 'done nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688 (setq dirs (cdr dirs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
691 (setq load-path (cons lispdir load-path)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 (if (not (package-get-load-package-file lispdir "auto-autoloads"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693 (package-get-load-package-file lispdir "_pkg"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 (defun package-get (package &optional version conflict install-dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 "Fetch PACKAGE from remote site.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 Optional arguments VERSION indicates which version to retrieve, nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 means most recent version. CONFLICT indicates what happens if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 package is already installed. Valid values for CONFLICT are:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
704 'always always retrieve the package even if it is already installed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 'never do not retrieve the package if it is installed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 INSTALL-DIR, if non-nil, specifies the package directory where
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 fetched packages should be installed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
709 The value of `package-get-base' is used to determine what files should
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 be retrieved. The value of `package-get-remote' is used to determine
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 where a package should be retrieved from. The sites are tried in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 order so one is better off listing easily reached sites first.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 Once the package is retrieved, its md5 checksum is computed. If that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 sum does not match that stored in `package-get-base' for this version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 of the package, an error is signalled.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 Returns `t' upon success, the symbol `error' if the package was
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 successfully installed but errors occurred during initialization, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 `nil' upon error."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 (interactive (package-get-interactive-package-query nil t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (catch 'skip-update
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 (let* ((this-package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 (package-get-info-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 (package-get-info-find-package package-get-base
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 package) version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 (latest (package-get-info-prop this-package 'version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 (installed (package-get-key package :version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 (this-requires (package-get-info-prop this-package 'requires))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 (found nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 (search-dirs package-get-remote)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 (base-filename (package-get-info-prop this-package 'filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 (package-status t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 filenames full-package-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 (if (null this-package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (if package-get-remote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (error "Couldn't find package %s with version %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 package version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (error "No download sites or local package locations specified.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (if (null base-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 (error "No filename associated with package %s, version %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 package version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 (setq install-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 (package-admin-get-install-dir package install-dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 (or (eq package 'mule-base) (memq 'mule-base this-requires))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 ;; If they asked for the latest using version=nil, don't get an older
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 ;; version than we already have.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 (if installed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 (if (> (if (stringp installed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751 (string-to-number installed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 installed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 (if (stringp latest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754 (string-to-number latest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 latest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 (if (not (null version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 (warn "Installing %s package version %s, you had a newer version %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 package latest installed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (warn "Skipping %s package, you have a newer version %s"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 package installed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 (throw 'skip-update t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 ;; Contrive a list of possible package filenames.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 ;; Ugly. Is there a better way to do this?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (setq filenames (cons base-filename nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (if (string-match "^\\(..*\\)\.tar\.gz$" base-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 (setq filenames (append filenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 (list (concat (match-string 1 base-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 ".tgz")))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 (setq version latest)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 (unless (and (eq conflict 'never)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (package-get-installedp package version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 ;; Find the package from the search list in package-get-remote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775 ;; and copy it into the staging directory. Then validate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 ;; the checksum. Finally, install the package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (catch 'done
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 (let (search-filenames current-dir-entry host dir current-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 dest-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 ;; In each search directory ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 (while search-dirs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (setq current-dir-entry (car search-dirs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 host (car current-dir-entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 dir (car (cdr current-dir-entry))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 search-filenames filenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 ;; Look for one of the possible package filenames ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 (while search-filenames
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 (setq current-filename (car search-filenames)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 dest-filename (package-get-staging-dir current-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 ;; No host means look on the current system.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 ( (null host)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 (setq full-package-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 (substitute-in-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 (expand-file-name current-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 (file-name-as-directory dir))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 ;; If it's already on the disk locally, and the size is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 ;; greater than zero ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 ( (and (file-exists-p dest-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 (let (attrs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 ;; file-attributes could return -1 for LARGE files,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 ;; but, hopefully, packages won't be that large.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 (and (setq attrs (file-attributes dest-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 (> (nth 7 attrs) 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (setq full-package-filename dest-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 ;; If the file exists on the remote system ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 ( (file-exists-p (package-get-remote-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 current-dir-entry current-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 ;; Get it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (setq full-package-filename dest-filename)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
817 (message "Retrieving package `%s' ..."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 current-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (copy-file (package-get-remote-filename current-dir-entry
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 current-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 full-package-filename t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 ;; If we found it, we're done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 (if (and full-package-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 (file-exists-p full-package-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 (throw 'done nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ;; Didn't find it. Try the next possible filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (setq search-filenames (cdr search-filenames))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 ;; Try looking in the next possible directory ...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 (setq search-dirs (cdr search-dirs))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 (if (or (not full-package-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 (not (file-exists-p full-package-filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 (if package-get-remote
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 (error "Unable to find file %s" base-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 "No download sites or local package locations specified.")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 ;; Validate the md5 checksum
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 ;; Doing it with XEmacs removes the need for an external md5 program
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 (message "Validating checksum for `%s'..." package) (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (with-temp-buffer
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
848 (insert-file-contents-literally full-package-filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (if (not (string= (md5 (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (package-get-info-prop this-package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 'md5sum)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (error "Package %s does not match md5 checksum" base-filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 (package-admin-delete-binary-package package install-dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 (message "Installing package `%s' ..." package) (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 (let ((status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 (package-admin-add-binary-package full-package-filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 install-dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 (if (= status 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 ;; clear messages so that only messages from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 ;; package-get-init-package are seen, below.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 (clear-message)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 (if (package-get-init-package (package-admin-get-lispdir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 install-dir package))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 (progn
628
e545f3ec2337 [xemacs-hg @ 2001-07-14 08:42:16 by youngs]
youngs
parents: 502
diff changeset
868 (run-hook-with-args 'package-install-hook package install-dir)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (message "Added package `%s'" package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 ;; display message only if there isn't already one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 (if (not (current-message))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (message "Added package `%s' (errors occurred)"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (if package-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (setq package-status 'errors))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (message "Installation of package %s failed." base-filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (sit-for 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 (switch-to-buffer package-admin-temp-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (setq package-status nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 ))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (setq found t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 (if (and found package-get-remove-copy)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 (delete-file full-package-filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 package-status
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 )))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 (defun package-get-info-find-package (which name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 "Look in WHICH for the package called NAME and return all the info
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 associated with it. See `package-get-base' for info on the format
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 To access fields returned from this, use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 `package-get-info-version' to return information about particular a
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 version. Use `package-get-info-find-prop' to find particular property
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 from a version returned by `package-get-info-version'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (interactive "xPackage list: \nsPackage Name: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (if which
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (if (eq (caar which) name)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 (cdar which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 (if (cdr which)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 (package-get-info-find-package (cdr which) name)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 (defun package-get-info-version (package version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
912 "In PACKAGE, return the plist associated with a particular VERSION of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 package. PACKAGE is typically as returned by
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
914 `package-get-info-find-package'. If VERSION is nil, then return the
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 first (aka most recent) version. Use `package-get-info-find-prop'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 to retrieve a particular property from the value returned by this."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 (interactive (package-get-interactive-package-query t t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 (while (and version package (not (string= (plist-get (car package) 'version) version)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 (setq package (cdr package)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 (if package (car package)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 (defun package-get-info-prop (package-version property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 "In PACKAGE-VERSION, return the value associated with PROPERTY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 PACKAGE-VERSION is typically returned by `package-get-info-version'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 and PROPERTY is typically (although not limited to) one of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 version - version of this package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 provides - list of symbols provided
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 requires - list of symbols that are required.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 These in turn are provided by other packages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 size - size of the bundled package
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 md5sum - computed md5 checksum"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 (interactive "xPackage Version: \nSProperty")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 (plist-get package-version property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 (defun package-get-info-version-prop (package-list package version property)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 "In PACKAGE-LIST, search for PACKAGE with this VERSION and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 PROPERTY value."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 (package-get-info-prop
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 (package-get-info-version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 (package-get-info-find-package package-list package) version) property))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 (defun package-get-set-version-prop (package-list package version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 property value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 "A utility to make it easier to add a VALUE for a specific PROPERTY
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 in this VERSION of a specific PACKAGE kept in the PACKAGE-LIST.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 Returns the modified PACKAGE-LIST. Any missing fields are created."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 )
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 (defun package-get-staging-dir (filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 "Return a good place to stash FILENAME when it is retrieved.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 Use `package-get-dir' for directory to store stuff.
629
a6c89d799f00 [xemacs-hg @ 2001-07-15 08:18:59 by adrian]
adrian
parents: 628
diff changeset
954 Creates `package-get-dir' if it doesn't exist."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 (interactive "FPackage filename: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (if (not (file-exists-p package-get-dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 (make-directory package-get-dir))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 (expand-file-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959 (file-name-nondirectory (or (and (fboundp 'efs-ftp-path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 (nth 2 (efs-ftp-path filename)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 filename))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 (file-name-as-directory package-get-dir)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 (defun package-get-remote-filename (search filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 "Return FILENAME as a remote filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 It first checks if FILENAME already is a remote filename. If it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 not, then it uses the (car search) as the remote site-name and the (cadr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 search) as the remote-directory and concatenates filename. In other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 words
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 site-name:remote-directory/filename.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 If (car search) is nil, (cadr search is interpreted as a local directory).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 "
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 (if (file-remote-p filename)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 filename
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 (let ((dir (cadr search)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 (concat (when (car search)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 (concat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 (if (string-match "@" (car search))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 "/"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 "/anonymous@")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 (car search) ":"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 (if (string-match "/$" dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 (concat dir "/"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 filename))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 (defun package-get-installedp (package version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 "Determine if PACKAGE with VERSION has already been installed.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
991 I'm not sure if I want to do this by searching directories or checking
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 some built in variables. For now, use packages-package-list."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 ;; Use packages-package-list which contains name and version
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 (equal (plist-get
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 (package-get-info-find-package packages-package-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 package) ':version)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 (if (floatp version) version (string-to-number version))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 (defun package-get-package-provider (sym &optional force-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 "Search for a package that provides SYM and return the name and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 version. Searches in `package-get-base' for SYM. If SYM is a
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1003 consp, then it must match a corresponding (provide (SYM VERSION)) from
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 the package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 If FORCE-CURRENT is non-nil make sure the database is up to date. This might
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 lead to Emacs accessing remote sites."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 (interactive "SSymbol: ")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 (package-get-require-base force-current)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 (let ((packages package-get-base)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 (done nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 (found nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 (while (and (not done) packages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 (let* ((this-name (caar packages))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 (this-package (cdr (car packages)))) ;strip off package name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 (while (and (not done) this-package)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 (if (or (eq this-name sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 (eq (cons this-name
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 (package-get-info-prop (car this-package) 'version))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 (member sym
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 (package-get-info-prop (car this-package) 'provides)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 (progn (setq done t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 (setq found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 (list (caar packages)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 (package-get-info-prop (car this-package) 'version))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 (setq this-package (cdr this-package)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 (setq packages (cdr packages)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 (when (interactive-p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 (if found
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 (message "%S" found)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 (message "No appropriate package found")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 found))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 ;; customize interfaces.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 ;; The group is in this file so that custom loads includes this file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 ;;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 (defgroup packages nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 "Configure XEmacs packages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 :group 'emacs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 ;;;###autoload
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 (defun package-get-custom ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 "Fetch and install the latest versions of all customized packages."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 (package-get-require-base t)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 (mapcar (lambda (pkg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 (if (eval (intern (concat (symbol-name (car pkg)) "-package")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 (package-get (car pkg) nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 t)
454
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
1052 package-get-base)
d7a9135ec789 Import from CVS: tag r21-2-42
cvs
parents: 444
diff changeset
1053 (package-net-update-installed-db))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 (defun package-get-ever-installed-p (pkg &optional notused)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 (string-match "-package$" (symbol-name pkg))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1057 (custom-initialize-set
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1058 pkg
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1059 (if (package-get-info-find-package
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1060 packages-package-list
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 (intern (substring (symbol-name pkg) 0 (match-beginning 0))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 t)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 (defvar package-get-custom-groups nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 "List of package-get-custom groups")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 (defun package-get-custom-add-entry (package props)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 (let* ((category (plist-get props 'category))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 (group (intern (concat category "-packages")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 (custom-var (intern (concat (symbol-name package) "-package")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 (description (plist-get props 'description)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 (when (not (memq group package-get-custom-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 (setq package-get-custom-groups (cons group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 package-get-custom-groups))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 (eval `(defgroup ,group nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 ,(concat category " package group")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 :group 'packages)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 (eval `(defcustom ,custom-var nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 ,description
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 :group ',group
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081 :initialize 'package-get-ever-installed-p
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1082 :type 'boolean))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1083
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085 (provide 'package-get)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 ;;; package-get.el ends here