# HG changeset patch # User Chong Yidong # Date 1288826511 14400 # Node ID 72d2a83a2641226cc9f41acb24216fe85f627c7b # Parent 230a50b33a46a95ab4a4a989b414f5d36951a918 * emacs-lisp/package.el (package-unpack): Remove no-op. (package--builtins, package--dir): Doc fix. (package-activate-1, package-activate, package-install) (package-compute-transaction): Fix error message. (package-delete): Use delete-directory. Omit system packages. (package-initialize): Set package-alist to nil first. (package-menu-mark-delete, package-menu-mark-install): Don't add symbols that are inconsistent with the package state. (package-menu-execute): Perform deletions and installations as single batch operations. diff -r 230a50b33a46 -r 72d2a83a2641 lisp/ChangeLog --- a/lisp/ChangeLog Wed Nov 03 16:08:48 2010 -0400 +++ b/lisp/ChangeLog Wed Nov 03 19:21:51 2010 -0400 @@ -1,3 +1,16 @@ +2010-11-03 Chong Yidong + + * emacs-lisp/package.el (package-unpack): Remove no-op. + (package--builtins, package--dir): Doc fix. + (package-activate-1, package-activate, package-install) + (package-compute-transaction): Fix error message. + (package-delete): Use delete-directory. Omit system packages. + (package-initialize): Set package-alist to nil first. + (package-menu-mark-delete, package-menu-mark-install): Don't add + symbols that are inconsistent with the package state. + (package-menu-execute): Perform deletions and installations as + single batch operations. + 2010-11-03 Glenn Morris * progmodes/idlwave.el (idlwave-pset): Only used on XEmacs. diff -r 230a50b33a46 -r 72d2a83a2641 lisp/emacs-lisp/package.el --- a/lisp/emacs-lisp/package.el Wed Nov 03 16:08:48 2010 -0400 +++ b/lisp/emacs-lisp/package.el Wed Nov 03 19:21:51 2010 -0400 @@ -77,7 +77,7 @@ ;; Other external functions you may want to use: ;; -;; M-x package-list-packages +;; M-x list-packages ;; Enters a mode similar to buffer-menu which lets you manage ;; packages. You can choose packages for install (mark with "i", ;; then "x" to execute) or deletion (not implemented yet), and you @@ -215,7 +215,6 @@ (declare-function url-http-parse-response "url-http" ()) (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-commentary "lisp-mnt" (&optional file)) -(declare-function dired-delete-file "dired" (file &optional recursive trash)) (defvar url-http-end-of-headers) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) @@ -278,9 +277,12 @@ ;; until it's needed (i.e. when `package-intialize' is called). (defvar package--builtins nil "Alist of built-in packages. +The actual value is initialized by loading the library +`finder-inf'; this is not done until it is needed, e.g. by the +function `package-built-in-p'. + Each element has the form (PKG . DESC), where PKG is a package name (a symbol) and DESC is a vector that describes the package. - The vector DESC has the form [VERSION REQS DOCSTRING]. VERSION is a version list. REQS is a list of packages (symbols) required by the package. @@ -389,8 +391,10 @@ "Extract the kind of download from an archive package description vector." (aref desc 3)) -(defun package--dir (name version-string) - (let* ((subdir (concat name "-" version-string)) +(defun package--dir (name version) + "Return the directory where a package is installed, or nil if none. +NAME and VERSION are both strings." + (let* ((subdir (concat name "-" version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -406,7 +410,7 @@ (version-str (package-version-join (package-desc-vers pkg-vec))) (pkg-dir (package--dir name version-str))) (unless pkg-dir - (error "Internal error: could not find directory for %s-%s" + (error "Internal error: unable to find directory for `%s-%s'" name version-str)) ;; Add info node. (when (file-exists-p (expand-file-name "dir" pkg-dir)) @@ -457,7 +461,7 @@ (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. -Required package `%s', version %s, is unavailable" +Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. (package-activate-1 package pkg-vec))))))) @@ -565,12 +569,8 @@ (defun package-unpack (name version) (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version) package-user-dir))) - ;; Be careful!! (make-directory package-user-dir t) - (if (file-directory-p pkg-dir) - (mapc (lambda (file) nil) ; 'delete-file -- FIXME: when we're - ; more confident - (directory-files pkg-dir t "^[^.]"))) + ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer) (package-generate-autoloads (symbol-name name) pkg-dir) @@ -608,7 +608,7 @@ (mapcar (lambda (elt) (list (car elt) - (package-version-join (car (cdr elt))))) + (package-version-join (cadr elt)))) requires)))) "\n") nil @@ -698,18 +698,18 @@ ((null (stringp hold)) (error "Invalid element in `package-load-list'")) ((version-list-< (version-to-list hold) next-version) - (error "Package '%s' held at version %s, \ + (error "Package `%s' held at version %s, \ but version %s required" (symbol-name next-pkg) hold (package-version-join next-version))))) (unless pkg-desc - (error "Package '%s', version %s, unavailable for installation" + (error "Package `%s-%s' is unavailable" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version (package-desc-vers (cdr pkg-desc))) (error - "Need package '%s' with version %s, but only %s is available" + "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) (package-version-join (package-desc-vers (cdr pkg-desc))))) ;; Only add to the transaction if we don't already have it. @@ -819,7 +819,7 @@ nil t)))) (let ((pkg-desc (assq name package-archive-contents))) (unless pkg-desc - (error "Package '%s' is not available for installation" + (error "Package `%s' is not available for installation" (symbol-name name))) (package-download-transaction (package-compute-transaction (list name) @@ -976,11 +976,16 @@ (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) - (require 'dired) ; for dired-delete-file - (dired-delete-file (expand-file-name (concat name "-" version) - package-user-dir) - ;; FIXME: query user? - 'always)) + (let ((dir (package--dir name version))) + (if (string-equal (file-name-directory dir) + (file-name-as-directory + (expand-file-name package-user-dir))) + (progn + (delete-directory dir t t) + (message "Package `%s-%s' deleted." name version)) + ;; Don't delete "system" packages + (error "Package `%s-%s' is a system package, not deleting" + name version)))) (defun package-archive-url (name) "Return the archive containing the package NAME." @@ -1030,7 +1035,8 @@ The variable `package-load-list' controls which packages to load. If optional arg NO-ACTIVATE is non-nil, don't activate packages." (interactive) - (setq package-obsolete-alist nil) + (setq package-alist nil + package-obsolete-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) (unless no-activate @@ -1361,12 +1367,16 @@ (defun package-menu-mark-delete (num) "Mark a package for deletion and move to the next line." (interactive "p") - (package-menu-mark-internal "D")) + (if (string-equal (package-menu-get-status) "installed") + (package-menu-mark-internal "D") + (forward-line))) (defun package-menu-mark-install (num) "Mark a package for installation and move to the next line." (interactive "p") - (package-menu-mark-internal "I")) + (if (string-equal (package-menu-get-status) "available") + (package-menu-mark-internal "I") + (forward-line))) (defun package-menu-mark-unmark (num) "Clear any marks on a package and move to the next line." @@ -1420,34 +1430,58 @@ ""))) (defun package-menu-execute () - "Perform all the marked actions. -Packages marked for installation will be downloaded and -installed. Packages marked for deletion will be removed. -Note that after installing packages you will want to restart -Emacs." + "Perform marked Package Menu actions. +Packages marked for installation are downloaded and installed; +packages marked for deletion are removed." (interactive) - (goto-char (point-min)) - (while (not (eobp)) - (let ((cmd (char-after)) - (pkg-name (package-menu-get-package)) - (pkg-vers (package-menu-get-version)) - (pkg-status (package-menu-get-status))) - (cond - ((eq cmd ?D) - (when (and (string= pkg-status "installed") - (string= pkg-name "package")) - ;; FIXME: actually, we could be tricky and remove all info. - ;; But that is drastic and the user can do that instead. - (error "Can't delete most recent version of `package'")) - ;; Ask for confirmation here? Maybe if package status is ""? - ;; Or if any lisp from package is actually loaded? - (message "Deleting %s-%s..." pkg-name pkg-vers) - (package-delete pkg-name pkg-vers) - (message "Deleting %s-%s... done" pkg-name pkg-vers)) - ((eq cmd ?I) - (package-install (intern pkg-name))))) - (forward-line)) - (package-menu-revert)) + (let (install-list delete-list cmd) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (setq cmd (char-after)) + (cond + ((eq cmd ?\s) t) + ((eq cmd ?D) + (push (cons (package-menu-get-package) + (package-menu-get-version)) + delete-list)) + ((eq cmd ?I) + (push (package-menu-get-package) install-list))) + (forward-line))) + ;; Delete packages, prompting if necessary. + (when delete-list + (if (yes-or-no-p + (if (= (length delete-list) 1) + (format "Delete package `%s-%s'? " + (caar delete-list) + (cdr (car delete-list))) + (format "Delete these %d packages (%s)? " + (length delete-list) + (mapconcat (lambda (elt) + (concat (car elt) "-" (cdr elt))) + delete-list + ", ")))) + (dolist (elt delete-list) + (condition-case err + (package-delete (car elt) (cdr elt)) + (error (message (cadr err))))) + (error "Aborted"))) + (when install-list + (if (yes-or-no-p + (if (= (length install-list) 1) + (format "Install package `%s'? " (car install-list)) + (format "Install these %d packages (%s)? " + (length install-list) + (mapconcat 'identity install-list ", ")))) + (dolist (elt install-list) + (package-install (intern elt))))) + ;; If we deleted anything, regenerate `package-alist'. This is done + ;; automatically if we installed a package. + (and delete-list (null install-list) + (package-initialize)) + (if (or delete-list install-list) + (package-menu-revert) + (message "No operations specified.")))) (defun package-print-package (package version key desc) (let ((face