X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d770725a3df5529f046198b2f7014918e13a06b1..70550acf88e5d7083d3aa83d201a8a7ebc3ba4b6:/lisp/emacs-lisp/package.el diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index f0b1537e2b..317fa1fd23 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1,6 +1,6 @@ ;;; 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 ;; Created: 10 Mar 2007 @@ -113,6 +113,8 @@ ;;; 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 @@ -224,7 +226,10 @@ Each element has the form (ID . LOCATION). 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 @@ -277,7 +282,7 @@ contrast, `package-user-dir' contains packages for personal use." :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 @@ -377,30 +382,37 @@ controls which package subdirectories may be loaded. 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." @@ -856,7 +868,13 @@ using `package-compute-transaction'." (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) @@ -871,6 +889,8 @@ archive in `package-archives'. Interactively, prompt for NAME." ;; 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) @@ -884,9 +904,7 @@ archive in `package-archives'. Interactively, prompt for NAME." (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. @@ -1076,6 +1094,7 @@ similar to an entry in `package-alist'. Save the cached copy to (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 @@ -1297,30 +1316,30 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." '(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] @@ -1658,10 +1677,11 @@ The list is displayed in a buffer named `*Packages*'." (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)