;;; package.el --- Simple package system for Emacs
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
;;; ToDo:
+;; - a trust mechanism, since compiling a package can run arbitrary code.
+;; For example, download package signatures and check that they match.
;; - putting info dirs at the start of the info path means
;; users see a weird ordering of categories. OTOH we want to
;; override later entries. maybe emacs needs to enforce
LOCATION specifies the base location for the archive.
If it starts with \"http:\", it is treated as a HTTP URL;
otherwise it should be an absolute directory name.
- (Other types of URL are currently not supported.)"
+ (Other types of URL are currently not supported.)
+
+Only add locations that you trust, since fetching and installing
+a package can run arbitrary code."
:type '(alist :key-type (string :tag "Archive name")
:value-type (string :tag "URL or directory name"))
:risky t
:version "24.1")
;; The value is precomputed in finder-inf.el, but don't load that
-;; until it's needed (i.e. when `package-intialize' is called).
+;; until it's needed (i.e. when `package-initialize' is called).
(defvar package--builtins nil
"Alist of built-in packages.
The actual value is initialized by loading the library
In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist' and `package-obsolete-alist'."
- (let ((all (memq 'all package-load-list))
- (regexp (concat "\\`" package-subdirectory-regexp "\\'"))
- name version force)
+ (let ((regexp (concat "\\`" package-subdirectory-regexp "\\'")))
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
- (when (and (file-directory-p (expand-file-name subdir dir))
- (string-match regexp subdir))
- (setq name (intern (match-string 1 subdir))
- version (match-string 2 subdir)
- force (assq name package-load-list))
- (when (cond
- ((null force)
- all) ; not in package-load-list
- ((null (setq force (cadr force)))
- nil) ; disabled
- ((eq force t)
- t)
- ((stringp force) ; held
- (version-list-= (version-to-list version)
- (version-to-list force)))
- (t
- (error "Invalid element in `package-load-list'")))
- (package-load-descriptor dir subdir))))))))
+ (when (string-match regexp subdir)
+ (package-maybe-load-descriptor (match-string 1 subdir)
+ (match-string 2 subdir)
+ dir)))))))
+
+(defun package-maybe-load-descriptor (name version dir)
+ "Maybe load a specific package from directory DIR.
+NAME and VERSION are the package's name and version strings.
+This function checks `package-load-list', before actually loading
+the package by calling `package-load-descriptor'."
+ (let ((force (assq (intern name) package-load-list))
+ (subdir (concat name "-" version)))
+ (and (file-directory-p (expand-file-name subdir dir))
+ ;; Check `package-load-list':
+ (cond ((null force)
+ (memq 'all package-load-list))
+ ((null (setq force (cadr force)))
+ nil) ; disabled
+ ((eq force t)
+ t)
+ ((stringp force) ; held
+ (version-list-= (version-to-list version)
+ (version-to-list force)))
+ (t
+ (error "Invalid element in `package-load-list'")))
+ ;; Actually load the descriptor:
+ (package-load-descriptor dir subdir))))
(defsubst package-desc-vers (desc)
"Extract version from a package description vector."
(package-desc-doc desc)
(package-desc-reqs desc)))
(t
- (error "Unknown package kind: %s" (symbol-name kind)))))))
+ (error "Unknown package kind: %s" (symbol-name kind))))
+ ;; If package A depends on package B, then A may `require' B
+ ;; during byte compilation. So we need to activate B before
+ ;; unpacking A.
+ (package-maybe-load-descriptor (symbol-name elt) v-string
+ package-user-dir)
+ (package-activate elt (version-to-list v-string)))))
(defvar package--initialized nil)
;; symbols for completion.
(unless package--initialized
(package-initialize t))
+ (unless package-archive-contents
+ (package-refresh-contents))
(list (intern (completing-read
"Install package: "
(mapcar (lambda (elt)
(symbol-name name)))
(package-download-transaction
(package-compute-transaction (list name)
- (package-desc-reqs (cdr pkg-desc)))))
- ;; Try to activate it.
- (package-initialize))
+ (package-desc-reqs (cdr pkg-desc))))))
(defun package-strip-rcs-id (str)
"Strip RCS version ID from the version string STR.
(let ((version-control 'never))
(save-buffer))))))
+;;;###autoload
(defun package-refresh-contents ()
"Download the ELPA archive description if needed.
This informs Emacs about the latest versions of all packages, and
'(menu-item "Unmark" package-menu-mark-unmark
:help "Clear any marks on a package and move to the next line"))
(define-key menu-map [munm]
- '(menu-item "Unmark backwards" package-menu-backup-unmark
+ '(menu-item "Unmark Backwards" package-menu-backup-unmark
:help "Back up one line and clear any marks on that package"))
(define-key menu-map [md]
- '(menu-item "Mark for deletion" package-menu-mark-delete
+ '(menu-item "Mark for Deletion" package-menu-mark-delete
:help "Mark a package for deletion and move to the next line"))
(define-key menu-map [mi]
- '(menu-item "Mark for install" package-menu-mark-install
+ '(menu-item "Mark for Install" package-menu-mark-install
:help "Mark a package for installation and move to the next line"))
(define-key menu-map [mupgrades]
- '(menu-item "Mark upgradable packages" package-menu-mark-upgrades
+ '(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
:help "Mark packages that have a newer version for upgrading"))
(define-key menu-map [s3] '("--"))
(define-key menu-map [mg]
- '(menu-item "Update package list" revert-buffer
+ '(menu-item "Update Package List" revert-buffer
:help "Update the list of packages"))
(define-key menu-map [mr]
- '(menu-item "Refresh package list" package-menu-refresh
+ '(menu-item "Refresh Package List" package-menu-refresh
:help "Download the ELPA archive"))
(define-key menu-map [s4] '("--"))
(define-key menu-map [mt]
- '(menu-item "Mark obsolete packages" package-menu-mark-obsolete-for-deletion
+ '(menu-item "Mark Obsolete Packages" package-menu-mark-obsolete-for-deletion
:help "Mark all obsolete packages for deletion"))
(define-key menu-map [mx]
- '(menu-item "Execute actions" package-menu-execute
+ '(menu-item "Execute Actions" package-menu-execute
:help "Perform all the marked actions"))
(define-key menu-map [s5] '("--"))
(define-key menu-map [mh]
(switch-to-buffer buf))
(let ((upgrades (package-menu--find-upgrades)))
(if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark them for upgrading."
+ (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading."
(length upgrades)
(if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")))))
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them")))))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
HCoop / bpt / emacs.git / blobdiff