Commit ebf662f4 authored by Chong Yidong's avatar Chong Yidong

Avoid corrupting archive-contents file.

* emacs-lisp/package.el (package--download-one-archive): Ensure
that archive-contents is valid before saving it.
(package-activate-1, package-mark-obsolete, define-package)
(package-compute-transaction, package-list-maybe-add): Use push.
parent 86441999
2010-09-02 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/package.el (package--download-one-archive): Ensure
that archive-contents is valid before saving it.
(package-activate-1, package-mark-obsolete, define-package)
(package-compute-transaction, package-list-maybe-add): Use push.
2010-09-03 Stefan Monnier <monnier@iro.umontreal.ca> 2010-09-03 Stefan Monnier <monnier@iro.umontreal.ca>
Use SMIE's blink-paren for octave-mode. Use SMIE's blink-paren for octave-mode.
......
...@@ -406,16 +406,15 @@ updates `package-alist' and `package-obsolete-alist'." ...@@ -406,16 +406,15 @@ updates `package-alist' and `package-obsolete-alist'."
(error "Internal error: could not find directory for %s-%s" (error "Internal error: could not find directory for %s-%s"
name version-str)) name version-str))
;; Add info node. ;; Add info node.
(if (file-exists-p (expand-file-name "dir" pkg-dir)) (when (file-exists-p (expand-file-name "dir" pkg-dir))
(progn ;; FIXME: not the friendliest, but simple.
;; FIXME: not the friendliest, but simple. (require 'info)
(require 'info) (info-initialize)
(info-initialize) (push pkg-dir Info-directory-list))
(setq Info-directory-list (cons pkg-dir Info-directory-list))))
;; Add to load path, add autoloads, and activate the package. ;; Add to load path, add autoloads, and activate the package.
(setq load-path (cons pkg-dir load-path)) (push pkg-dir load-path)
(load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
(setq package-activated-list (cons package package-activated-list)) (push package package-activated-list)
;; Don't return nil. ;; Don't return nil.
t)) t))
...@@ -466,10 +465,9 @@ Return nil if the package could not be activated." ...@@ -466,10 +465,9 @@ Return nil if the package could not be activated."
(setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
(cdr elt)))) (cdr elt))))
;; Make a new association. ;; Make a new association.
(setq package-obsolete-alist (push (cons package (list (cons (package-desc-vers pkg-vec)
(cons (cons package (list (cons (package-desc-vers pkg-vec) pkg-vec)))
pkg-vec))) package-obsolete-alist))))
package-obsolete-alist)))))
(defun define-package (name-str version-string (defun define-package (name-str version-string
&optional docstring requirements &optional docstring requirements
...@@ -505,7 +503,7 @@ EXTRA-PROPERTIES is currently unused." ...@@ -505,7 +503,7 @@ EXTRA-PROPERTIES is currently unused."
(setq package-alist (delq pkg-desc package-alist)) (setq package-alist (delq pkg-desc package-alist))
(package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) (package-mark-obsolete (car pkg-desc) (cdr pkg-desc)))
;; Add package to the alist. ;; Add package to the alist.
(setq package-alist (cons new-pkg-desc package-alist))) (push new-pkg-desc package-alist))
;; You can have two packages with the same version, for instance ;; You can have two packages with the same version, for instance
;; one in the system package directory and one in your private ;; one in the system package directory and one in your private
;; directory. We just let the first one win. ;; directory. We just let the first one win.
...@@ -707,7 +705,7 @@ but version %s required" ...@@ -707,7 +705,7 @@ but version %s required"
(package-version-join (package-desc-vers (cdr pkg-desc))))) (package-version-join (package-desc-vers (cdr pkg-desc)))))
;; Only add to the transaction if we don't already have it. ;; Only add to the transaction if we don't already have it.
(unless (memq next-pkg package-list) (unless (memq next-pkg package-list)
(setq package-list (cons next-pkg package-list))) (push next-pkg package-list))
(setq package-list (setq package-list
(package-compute-transaction package-list (package-compute-transaction package-list
(package-desc-reqs (package-desc-reqs
...@@ -992,17 +990,19 @@ The file can either be a tar file or an Emacs Lisp file." ...@@ -992,17 +990,19 @@ The file can either be a tar file or an Emacs Lisp file."
(re-search-forward "^$" nil 'move) (re-search-forward "^$" nil 'move)
(forward-char) (forward-char)
(delete-region (point-min) (point)) (delete-region (point-min) (point))
(make-directory dir t) ;; Read the retrieved buffer to make sure it is valid (e.g. it
(setq buffer-file-name (expand-file-name file dir)) ;; may fetch a URL redirect page).
(let ((version-control 'never)) (when (listp (read buffer))
(save-buffer))) (make-directory dir t)
(setq buffer-file-name (expand-file-name file dir))
(let ((version-control 'never))
(save-buffer))))
(kill-buffer buffer))) (kill-buffer buffer)))
(defun package-refresh-contents () (defun package-refresh-contents ()
"Download the ELPA archive description if needed. "Download the ELPA archive description if needed.
Invoking this will ensure that Emacs knows about the latest versions This informs Emacs about the latest versions of all packages, and
of all packages. This will let Emacs make them available for makes them available for download."
download."
(interactive) (interactive)
(unless (file-exists-p package-user-dir) (unless (file-exists-p package-user-dir)
(make-directory package-user-dir t)) (make-directory package-user-dir t))
...@@ -1301,11 +1301,9 @@ Letters do not insert themselves; instead, they are commands. ...@@ -1301,11 +1301,9 @@ Letters do not insert themselves; instead, they are commands.
(run-mode-hooks 'package-menu-mode-hook)) (run-mode-hooks 'package-menu-mode-hook))
(defun package-menu-refresh () (defun package-menu-refresh ()
"Download the ELPA archive. "Download the Emacs Lisp package archive.
This fetches the file describing the current contents of This fetches the contents of each archive specified in
the Emacs Lisp Package Archive, and then refreshes the `package-archives', and then refreshes the package menu."
package menu. This lets you see what new packages are
available for download."
(interactive) (interactive)
(unless (eq major-mode 'package-menu-mode) (unless (eq major-mode 'package-menu-mode)
(error "The current buffer is not a Package Menu")) (error "The current buffer is not a Package Menu"))
...@@ -1460,8 +1458,7 @@ Emacs." ...@@ -1460,8 +1458,7 @@ Emacs."
(defun package-list-maybe-add (package version status description result) (defun package-list-maybe-add (package version status description result)
(unless (assoc (cons package version) result) (unless (assoc (cons package version) result)
(setq result (cons (list (cons package version) status description) (push (list (cons package version) status description) result))
result)))
result) result)
(defvar package-menu-package-list nil (defvar package-menu-package-list nil
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment