[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Re: package.el changes before the feature freeze
|
From: |
Daniel Hackney |
|
Subject: |
[PATCH] Re: package.el changes before the feature freeze |
|
Date: |
Wed, 3 Oct 2012 18:41:36 -0400 |
I've updated the patch and have created a fairly broad test suite.
Installing single- and multi-file packages works for sure, as does
pulling descriptions down from an "archive-contents" source and the
package menu updates correctly upon package installation. One thing
which has annoyed me about the existing package.el is when updating
existing packages, `install-package' will warn that the
"foo-autoloads.el" file is newer than the buffer; I've solved this by
killing "foo-autoloads.el" after it has been generated and written to
disk.
I haven't yet tested updating or deleting packages. In the worst case,
restarting Emacs should cause the newer version to be loaded instead.
I've included the patch below, but I've also uploaded it in case email
formatting does something weird.
https://github.com/downloads/haxney/package/package-defstruct.diff
The complete source for the current version can be downloaded here:
https://github.com/haxney/package/tarball/first-submission
Comments welcome!
diff --git a/package.el b/package.el
index 28d1662..7cde23d 100644
--- a/package.el
+++ b/package.el
@@ -4,15 +4,15 @@
;; Author: Tom Tromey <address@hidden>
;; Created: 10 Mar 2007
-;; Version: 1.0
+;; Version: 1.5
;; Keywords: tools
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software: you can redistribute it and/or modify
+;; GNU Emacs 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 3 of the License, or
-;; (at your option) any later version.
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -20,15 +20,9 @@
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Change Log:
-
-;; 2 Apr 2007 - now using ChangeLog file
-;; 15 Mar 2007 - updated documentation
-;; 14 Mar 2007 - Changed how obsolete packages are handled
-;; 13 Mar 2007 - Wrote package-install-from-buffer
-;; 12 Mar 2007 - Wrote package-menu mode
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
@@ -99,17 +93,18 @@
;;; Thanks:
;;; (sorted by sort-lines):
+;; Daniel Hackney <address@hidden>
;; Jim Blandy <address@hidden>
;; Karl Fogel <address@hidden>
;; Kevin Ryde <address@hidden>
;; Lawrence Mitchell
;; Michael Olson <address@hidden>
+;; Phil Hagelberg <address@hidden>
;; Sebastian Tennant <address@hidden>
;; Stefan Monnier <address@hidden>
;; Vinicius Jose Latorre <address@hidden>
-;; Phil Hagelberg <address@hidden>
-;;; ToDo:
+;;; TODO:
;; - a trust mechanism, since compiling a package can run arbitrary code.
;; For example, download package signatures and check that they match.
@@ -124,9 +119,6 @@
;; - give users a way to view a package's documentation when it
;; only appears in the .el
;; - use/extend checkdoc so people can tell if their package will work
-;; - "installed" instead of a blank in the status column
-;; - tramp needs its files to be compiled in a certain order.
-;; how to handle this? fix tramp?
;; - on emacs 21 we don't kill the -autoloads.el buffer. what about 22?
;; - maybe we need separate .elc directories for various emacs versions
;; and also emacs-vs-xemacs. That way conditional compilation can
@@ -139,26 +131,18 @@
;; installing it
;; - Interface with desktop.el so that restarting after an install
;; works properly
-;; - Implement M-x package-upgrade, to upgrade any/all existing packages
;; - Use hierarchical layout. PKG/etc PKG/lisp PKG/info
;; ... except maybe lisp?
;; - It may be nice to have a macro that expands to the package's
;; private data dir, aka ".../etc". Or, maybe data-directory
;; needs to be a list (though this would be less nice)
;; a few packages want this, eg sokoban
-;; - package menu needs:
-;; ability to know which packages are built-in & thus not deletable
-;; it can sometimes print odd results, like 0.3 available but 0.4 active
-;; why is that?
;; - Allow multiple versions on the server...?
;; [ why bother? ]
;; - Don't install a package which will invalidate dependencies overall
-;; - Allow something like (or (>= emacs 21.0) (>= xemacs 21.5))
-;; [ currently thinking, why bother.. KISS ]
;; - Allow optional package dependencies
;; then if we require 'bbdb', bbdb-specific lisp in lisp/bbdb
;; and just don't compile to add to load path ...?
-;; - Have a list of archive URLs? [ maybe there's no point ]
;; - David Kastrup pointed out on the xemacs list that for GPL it
;; is friendlier to ship the source tree. We could "support" that
;; by just having a "src" subdir in the package. This isn't ideal
@@ -169,6 +153,8 @@
;;; Code:
+(require 'cl-lib)
+
(require 'tabulated-list)
(defgroup package nil
@@ -229,7 +215,7 @@ Each element has the form (ID . LOCATION).
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"))
+ :value-type (string :tag "URL or directory name"))
:risky t
:group 'package
:version "24.1")
@@ -238,17 +224,14 @@ a package can run arbitrary code."
"Version number of the package archive understood by this file.
Lower version numbers than this will probably be understood as well.")
-(defconst package-el-version "1.0"
+(defconst package-el-version "1.5"
"Version of package.el.")
;; We don't prime the cache since it tends to get out of date.
(defvar package-archive-contents nil
"Cache of the contents of the Emacs Lisp Package Archive.
-This is an alist mapping package names (symbols) to package
-descriptor vectors. These are like the vectors for `package-alist'
-but have extra entries: one which is 'tar for tar packages and
-'single for single-file packages, and one which is the name of
-the archive from which it came.")
+This is an alist mapping package names (symbols) to
+`package-desc' structures.")
(put 'package-archive-contents 'risky-local-variable t)
(defcustom package-user-dir (locate-user-emacs-file "elpa")
@@ -279,6 +262,50 @@ contrast, `package-user-dir' contains packages
for personal use."
:group 'package
:version "24.1")
+(cl-defstruct (package-desc
+ (:constructor
+ define-package-desc
+ (name-string version-string &optional (doc "No description
available.") requirements
+ &key kind archive lisp-dirs commentary
+ &aux (name (intern name-string))
+ ;; `version-to-list' errors out if its arg is "" or
+ ;; nil, but the `version-list-*' function accept
nil
+ ;; just fine.
+ (vers (if (zerop (length version-string))
+ nil
+ (version-to-list version-string)))
+ (reqs (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
+ requirements)))))
+ "Structure containing information about an individual package."
+ name
+ vers
+ (doc "No description available.")
+ reqs
+ kind
+ archive
+ (lisp-dirs '("."))
+ commentary)
+
+;; Translations for the old versions of package-desc-* substitutions.
+(defsubst package-old-desc-vers (desc)
+ "Extract version from an old-style package description vector."
+ (aref desc 0))
+
+(defsubst package-old-desc-reqs (desc)
+ "Extract requirements from an old-style package description vector."
+ (aref desc 1))
+
+(defsubst package-old-desc-doc (desc)
+ "Extract doc string from an old-style package description vector."
+ (aref desc 2))
+
+(defsubst package-old-desc-kind (desc)
+ "Extract the kind of download from an old-style archive package
description vector."
+ (aref desc 3))
+
;; The value is precomputed in finder-inf.el, but don't load that
;; until it's needed (i.e. when `package-initialize' is called).
(defvar package--builtins nil
@@ -288,26 +315,13 @@ The actual value is initialized by loading the library
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-LIST REQS DOCSTRING].
- VERSION-LIST is a version list.
- REQS is a list of packages required by the package, each
- requirement having the form (NAME VL), where NAME is a string
- and VL is a version list.
- DOCSTRING is a brief description of the package.")
+name (a symbol) and DESC is a `package-desc' structure.")
(put 'package--builtins 'risky-local-variable t)
(defvar package-alist nil
"Alist of all packages available for activation.
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-LIST REQS DOCSTRING].
- VERSION-LIST is a version list.
- REQS is a list of packages required by the package, each
- requirement having the form (NAME VL) where NAME is a string
- and VL is a version list.
- DOCSTRING is a brief description of the package.
+name (a symbol) and DESC is a `package-desc' structure.
This variable is set automatically by `package-load-descriptor',
called via `package-initialize'. To change which packages are
@@ -320,8 +334,8 @@ loaded and/or activated, customize `package-load-list'.")
(defvar package-obsolete-alist nil
"Representation of obsolete packages.
-Like `package-alist', but maps package name to a second alist.
-The inner alist is keyed by version.")
+Each element of the list is (NAME . VERSION-ALIST), where each
+entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).")
(put 'package-obsolete-alist 'risky-local-variable t)
(defun package-version-join (vlist)
@@ -367,8 +381,7 @@ the package name and VERSION is its version."
(pkg-file (expand-file-name
(concat (package-strip-version package) "-pkg")
pkg-dir)))
- (when (and (file-directory-p pkg-dir)
- (file-exists-p (concat pkg-file ".el")))
+ (when (file-directory-p pkg-dir)
(load pkg-file nil t))))
(defun package-load-all-descriptors ()
@@ -412,26 +425,59 @@ the package by calling `package-load-descriptor'."
;; Actually load the descriptor:
(package-load-descriptor dir subdir))))
-(defsubst package-desc-vers (desc)
- "Extract version from a package description vector."
- (aref desc 0))
+(defvar package-builtins-newified nil
+ "non-nil if `package-newify-builtins' has been run.
+The `finder-inf' library uses old-style package definitions which
+must be converted to the new `package-desc' version.")
-(defsubst package-desc-reqs (desc)
- "Extract requirements from a package description vector."
- (aref desc 1))
+(defun package-newify-one-builtin (pkg)
+ "Change a single old-style PKG into a `package-desc'.
+PKG should be (NAME . PACKAGE-VECTOR) where PACKAGE-VECTOR is
+\[VERSION-LIST DEPENDENCIES DOC]."
+ (require 'lisp-mnt)
+ (require 'whitespace)
+ (let* ((pkg-name (symbol-name (car pkg)))
+ (pkg-vers (package-old-desc-vers (cdr pkg)))
+ (pkg-reqs (package-old-desc-reqs (cdr pkg)))
+ (pkg-desc (package-old-desc-doc (cdr pkg)))
+ (commentary
+ (with-temp-buffer
+ (let ((fn (locate-file (concat pkg-name ".el") load-path
+ load-file-rep-suffixes))
+ (whitespace-style '(empty trailing)))
+ (insert (or (lm-commentary fn) ""))
+ (goto-char (point-min))
+ ;; `lm-commentary' returns the commentary section with leading
+ ;; semicolons. Strip these out.
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))
+ (whitespace-cleanup)
+ (buffer-substring-no-properties (point-min) (point-max))))))
+ ;; Result should be an element for an alist.
+ (cons (car pkg) (define-package-desc
+ pkg-name
+ (package-version-join pkg-vers)
+ pkg-desc
+ pkg-reqs
+ :commentary commentary
+ :kind 'builtin))))
-(defsubst package-desc-doc (desc)
- "Extract doc string from a package description vector."
- (aref desc 2))
+(defun package-newify-builtins ()
+ "Migrate `package--builtins' to list of `package-desc'."
+ (unless package-builtins-newified
+ (setq package--builtins
+ (mapcar #'package-newify-one-builtin package--builtins)
+ package-builtins-newified t)))
-(defsubst package-desc-kind (desc)
- "Extract the kind of download from an archive package description vector."
- (aref desc 3))
+(eval-after-load 'finder-inf
+ '(package-newify-builtins))
(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))
+ (let* ((subdir (format "%s-%s" name version))
(dir-list (cons package-user-dir package-directory-list))
pkg-dir)
(while dir-list
@@ -442,9 +488,9 @@ NAME and VERSION are both strings."
(setq dir-list (cdr dir-list)))))
pkg-dir))
-(defun package-activate-1 (package pkg-vec)
- (let* ((name (symbol-name package))
- (version-str (package-version-join (package-desc-vers pkg-vec)))
+(defun package-activate-1 (pkg-desc)
+ (let* ((name (package-desc-name pkg-desc))
+ (version-str (package-version-join (package-desc-vers pkg-desc)))
(pkg-dir (package--dir name version-str)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s-%s'"
@@ -457,8 +503,8 @@ NAME and VERSION are both strings."
(push pkg-dir Info-directory-list))
;; Add to load path, add autoloads, and activate the package.
(push pkg-dir load-path)
- (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t)
- (push package package-activated-list)
+ (load (expand-file-name (concat (symbol-name name) "-autoloads")
pkg-dir) nil t)
+ (push name package-activated-list)
;; Don't return nil.
t))
@@ -482,11 +528,11 @@ specifying the minimum acceptable version."
MIN-VERSION should be a version list.
If PACKAGE has any dependencies, recursively activate them.
Return nil if the package could not be activated."
- (let ((pkg-vec (cdr (assq package package-alist)))
+ (let ((pkg-desc (cdr (assq package package-alist)))
available-version found)
;; Check if PACKAGE is available in `package-alist'.
- (when pkg-vec
- (setq available-version (package-desc-vers pkg-vec)
+ (when pkg-desc
+ (setq available-version (package-desc-vers pkg-desc)
found (version-list-<= min-version available-version)))
(cond
;; If no such package is found, maybe it's built-in.
@@ -499,7 +545,7 @@ Return nil if the package could not be activated."
(t
(let ((fail (catch 'dep-failure
;; Activate its dependencies recursively.
- (dolist (req (package-desc-reqs pkg-vec))
+ (dolist (req (package-desc-reqs pkg-desc))
(unless (package-activate (car req) (cadr req))
(throw 'dep-failure req))))))
(if fail
@@ -507,25 +553,26 @@ Return nil if the package could not be activated."
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)))))))
+ (package-activate-1 pkg-desc)))))))
-(defun package-mark-obsolete (package pkg-vec)
- "Put package on the obsolete list, if not already there."
- (let ((elt (assq package package-obsolete-alist)))
- (if elt
- ;; If this obsolete version does not exist in the list, update
- ;; it the list.
- (unless (assoc (package-desc-vers pkg-vec) (cdr elt))
- (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec)
- (cdr elt))))
+(defun package-mark-obsolete (pkg-desc)
+ "Put PKG-DESC on the obsolete list, if not already there."
+ (let* ((name (package-desc-name pkg-desc))
+ (existing-elt (assq name package-obsolete-alist))
+ (pkg-version (package-desc-vers pkg-desc)))
+ (if existing-elt
+ ;; Add this obsolete version to the list if it is not already there.
+ (unless (assoc pkg-version (cdr existing-elt))
+ (setcdr existing-elt (cons (cons pkg-version pkg-desc)
+ (cdr existing-elt))))
;; Make a new association.
- (push (cons package (list (cons (package-desc-vers pkg-vec)
- pkg-vec)))
+ (push (cons name (list (cons pkg-version
+ pkg-desc)))
package-obsolete-alist))))
(defun define-package (name-string version-string
- &optional docstring requirements
- &rest _extra-properties)
+ &optional docstring requirements
+ &rest extra-properties)
"Define a new package.
NAME-STRING is the name of the package, as a string.
VERSION-STRING is the version of the package, as a string.
@@ -534,18 +581,23 @@ REQUIREMENTS is a list of dependencies on other packages.
Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION),
where OTHER-VERSION is a string.
-EXTRA-PROPERTIES is currently unused."
+EXTRA-PROPERTIES is a plist with the following keys:
+
+ :lisp-dirs DIRNAMES
+
+ DIRNAMES is a list of the form (dir1 dir2 ...) where each
+ item of the list is a directory which contains elisp source
+ to be processed."
(let* ((name (intern name-string))
(version (version-to-list version-string))
(new-pkg-desc
(cons name
- (vector version
- (mapcar
- (lambda (elt)
- (list (car elt)
- (version-to-list (car (cdr elt)))))
- requirements)
- docstring)))
+ (apply 'define-package-desc
+ name-string
+ version-string
+ docstring
+ requirements
+ extra-properties)))
(old-pkg (assq name package-alist)))
(cond
;; If there's no old package, just add this to `package-alist'.
@@ -553,7 +605,7 @@ EXTRA-PROPERTIES is currently unused."
(push new-pkg-desc package-alist))
((version-list-< (package-desc-vers (cdr old-pkg)) version)
;; Remove the old package and declare it obsolete.
- (package-mark-obsolete name (cdr old-pkg))
+ (package-mark-obsolete (cdr old-pkg))
(setq package-alist (cons new-pkg-desc
(delq old-pkg package-alist))))
;; You can have two packages with the same version, e.g. one in
@@ -561,7 +613,7 @@ EXTRA-PROPERTIES is currently unused."
;; directory. We just let the first one win.
((not (version-list-= (package-desc-vers (cdr old-pkg)) version))
;; The package is born obsolete.
- (package-mark-obsolete name (cdr new-pkg-desc))))))
+ (package-mark-obsolete (cdr new-pkg-desc))))))
;; From Emacs 22.
(defun package-autoload-ensure-default-file (file)
@@ -585,12 +637,13 @@ EXTRA-PROPERTIES is currently unused."
(defun package-generate-autoloads (name pkg-dir)
(require 'autoload) ;Load before we let-bind generated-autoload-file!
(let* ((auto-name (concat name "-autoloads.el"))
- ;;(ignore-name (concat name "-pkg.el"))
+ (ignore-name (concat name "-pkg.el"))
(generated-autoload-file (expand-file-name auto-name pkg-dir))
(version-control 'never))
(unless (fboundp 'autoload-ensure-default-file)
(package-autoload-ensure-default-file generated-autoload-file))
- (update-directory-autoloads pkg-dir)))
+ (update-directory-autoloads pkg-dir)
+ (kill-buffer (get-file-buffer generated-autoload-file))))
(defvar tar-parse-info)
(declare-function tar-untar-buffer "tar-mode" ())
@@ -608,9 +661,10 @@ untar into a directory named DIR; otherwise,
signal an error."
(error "Package does not untar cleanly into directory %s/" dir))))
(tar-untar-buffer))
-(defun package-unpack (package version)
- (let* ((name (symbol-name package))
- (dirname (concat name "-" version))
+(defun package-unpack (name version)
+ "Unpack a tar package.
+NAME and VERSION must be strings."
+ (let* ((dirname (concat name "-" version))
(pkg-dir (expand-file-name dirname package-user-dir)))
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
@@ -632,18 +686,19 @@ PKG-DIR is the name of the package directory."
(let ((buffer-file-coding-system 'no-conversion))
(write-region (point-min) (point-max) file-name)))
-(defun package-unpack-single (file-name version desc requires)
- "Install the contents of the current buffer as a package."
+(defun package-unpack-single (name version desc requires)
+ "Install the contents of the current buffer as a package.
+
+NAME, VERSION, and DESC must be strings."
;; Special case "package".
- (if (string= file-name "package")
+ (if (string= name "package")
(package--write-file-no-coding
- (expand-file-name (concat file-name ".el") package-user-dir))
- (let* ((pkg-dir (expand-file-name (concat file-name "-"
- (package-version-join
- (version-to-list version)))
+ (expand-file-name (concat name ".el") package-user-dir))
+ (let* ((pkg-dir (expand-file-name (concat name "-"
+ version)
package-user-dir))
- (el-file (expand-file-name (concat file-name ".el") pkg-dir))
- (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
+ (el-file (expand-file-name (concat name ".el") pkg-dir))
+ (pkg-file (expand-file-name (concat name "-pkg.el") pkg-dir)))
(make-directory pkg-dir t)
(package--write-file-no-coding el-file)
(let ((print-level nil)
@@ -652,21 +707,22 @@ PKG-DIR is the name of the package directory."
(concat
(prin1-to-string
(list 'define-package
- file-name
+ name
version
desc
- (list 'quote
- ;; Turn version lists into string form.
- (mapcar
- (lambda (elt)
- (list (car elt)
- (package-version-join (cadr elt))))
- requires))))
+ (when requires
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires)))))
"\n")
nil
pkg-file
nil nil nil 'excl))
- (package--make-autoloads-and-compile file-name pkg-dir))))
+ (package--make-autoloads-and-compile name pkg-dir))))
(defmacro package--with-work-buffer (location file &rest body)
"Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -716,14 +772,14 @@ It will move point to somewhere in the headers."
(let ((location (package-archive-base name))
(file (concat (symbol-name name) "-" version ".el")))
(package--with-work-buffer location file
- (package-unpack-single (symbol-name name) version desc requires))))
+ (package-unpack-single (symbol-name name)
version desc requires))))
(defun package-download-tar (name version)
"Download and install a tar package."
(let ((location (package-archive-base name))
(file (concat (symbol-name name) "-" version ".tar")))
(package--with-work-buffer location file
- (package-unpack name version))))
+ (package-unpack (symbol-name name) version))))
(defun package-installed-p (package &optional min-version)
"Return true if PACKAGE, of MIN-VERSION or newer, is installed.
@@ -754,7 +810,7 @@ not included in this list."
(unless (package-installed-p next-pkg next-version)
;; A package is required, but not installed. It might also be
;; blocked via `package-load-list'.
- (let ((pkg-desc (assq next-pkg package-archive-contents))
+ (let ((pkg-desc (cdr (assq next-pkg package-archive-contents)))
hold)
(when (setq hold (assq next-pkg package-load-list))
(setq hold (cadr hold))
@@ -767,25 +823,25 @@ not included in this list."
((version-list-< (version-to-list hold) next-version)
(error "Package `%s' held at version %s, \
but version %s required"
- (symbol-name next-pkg) hold
+ next-pkg hold
(package-version-join next-version)))))
(unless pkg-desc
(error "Package `%s-%s' is unavailable"
- (symbol-name next-pkg)
+ next-pkg
(package-version-join next-version)))
(unless (version-list-<= next-version
- (package-desc-vers (cdr pkg-desc)))
+ (package-desc-vers pkg-desc))
(error
"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)))))
+ next-pkg (package-version-join next-version)
+ (package-version-join (package-desc-vers pkg-desc))))
;; Only add to the transaction if we don't already have it.
(unless (memq next-pkg package-list)
(push next-pkg package-list))
(setq package-list
(package-compute-transaction package-list
(package-desc-reqs
- (cdr pkg-desc))))))))
+ pkg-desc)))))))
package-list)
(defun package-read-from-string (str)
@@ -800,7 +856,7 @@ Signal an error if the entire string was not used."
t)
(end-of-file nil))))
(if more-left
- (error "Can't read whole string")
+ (error "Can't read whole string")
(car read-data))))
(defun package--read-archive-file (file)
@@ -838,17 +894,22 @@ If the archive version is too new, signal an error."
(package--add-to-archive-contents package archive)))))
(defun package--add-to-archive-contents (package archive)
- "Add the PACKAGE from the given ARCHIVE if necessary.
-Also, add the originating archive to the end of the package vector."
- (let* ((name (car package))
- (version (package-desc-vers (cdr package)))
- (entry (cons name
- (vconcat (cdr package) (vector archive))))
- (existing-package (assq name package-archive-contents)))
+ "Add the (old-style) PACKAGE from the given ARCHIVE if necessary.
+Also, add the originating archive to the `package-desc' structure."
+ (let* ((name (car package))
+ (pkg-desc
+ (make-package-desc :name name
+ :vers (package-old-desc-vers (cdr package))
+ :reqs (package-old-desc-reqs (cdr package))
+ :doc (package-old-desc-doc (cdr package))
+ :kind (package-old-desc-kind (cdr package))
+ :archive archive))
+ (entry (cons name pkg-desc))
+ (existing-package (assq name package-archive-contents)))
(cond ((not existing-package)
(add-to-list 'package-archive-contents entry))
((version-list-< (package-desc-vers (cdr existing-package))
- version)
+ (package-desc-vers pkg-desc))
;; Replace the entry with this one.
(setq package-archive-contents
(cons entry
@@ -928,17 +989,7 @@ Otherwise return nil."
(error nil))))
(defun package-buffer-info ()
- "Return a vector describing the package in the current buffer.
-The vector has the form
-
- [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
-
-FILENAME is the file name, a string, sans the \".el\" extension.
-REQUIRES is a list of requirements, each requirement having the
- form (NAME VER); NAME is a string and VER is a version list.
-DESCRIPTION is the package description, a string.
-VERSION is the version, a string.
-COMMENTARY is the commentary section, a string, or nil if none.
+ "Return a `package-desc' for the package in the current buffer.
If the buffer does not contain a conforming package, signal an
error. If there is a package, narrow the buffer to the file's
@@ -968,19 +1019,24 @@ boundaries."
(unless pkg-version
(error
"Package lacks a \"Version\" or \"Package-Version\" header"))
- ;; Turn string version numbers into list form.
- (setq requires
- (mapcar
- (lambda (elt)
- (list (car elt)
- (version-to-list (car (cdr elt)))))
- requires))
- (vector file-name requires desc pkg-version commentary))))
+
+ (define-package-desc
+ file-name
+ pkg-version
+ desc
+ requires
+ :commentary commentary
+ :kind 'single))))
+
+(defun package-shell-command-to-string-noerr (command)
+ "Like `shell-command-to-string' but ignores stderr."
+ (with-output-to-string
+ (with-current-buffer
+ standard-output
+ (process-file shell-file-name nil '(t nil) nil
shell-command-switch command))))
(defun package-tar-file-info (file)
- "Find package information for a tar file.
-FILE is the name of the tar file to examine.
-The return result is a vector like `package-buffer-info'."
+ "Extract a `package-desc' from a tar file."
(let ((default-directory (file-name-directory file))
(file (file-name-nondirectory file)))
(unless (string-match (concat "\\`" package-subdirectory-regexp
"\\.tar\\'")
@@ -998,61 +1054,60 @@ The return result is a vector like
`package-buffer-info'."
(pkg-def-parsed (package-read-from-string pkg-def-contents)))
(unless (eq (car pkg-def-parsed) 'define-package)
(error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
- (let ((name-str (nth 1 pkg-def-parsed))
- (version-string (nth 2 pkg-def-parsed))
- (docstring (nth 3 pkg-def-parsed))
- (requires (nth 4 pkg-def-parsed))
- (readme (shell-command-to-string
- ;; Requires GNU tar.
- (concat "tar -xOf " file " "
- pkg-name "-" pkg-version "/README"))))
- (unless (equal pkg-version version-string)
+
+ (let* ((readme (package-shell-command-to-string-noerr
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+ pkg-name "-" pkg-version "/README")))
+ ;; Horrible hack until `define-package' becomes side-effect-free.
Replace
+ ;; `define-package' with `define-package-desc' (which doesn't have
+ ;; side-effects), add the readme, and eval that instead.
+ (pkg-desc (eval (append (cons 'define-package-desc (cdr
pkg-def-parsed))
+ `(:commentary ,readme
+ :kind 'tar)))))
+ (unless (equal (package-version-join (package-desc-vers pkg-desc))
+ pkg-version)
(error "Package has inconsistent versions"))
- (unless (equal pkg-name name-str)
+ (unless (equal (symbol-name (package-desc-name pkg-desc))
+ pkg-name)
(error "Package has inconsistent names"))
- ;; Kind of a hack.
- (if (string-match ": Not found in archive" readme)
- (setq readme nil))
- ;; Turn string version numbers into list form.
- (if (eq (car requires) 'quote)
- (setq requires (car (cdr requires))))
- (setq requires
- (mapcar (lambda (elt)
- (list (car elt)
- (version-to-list (cadr elt))))
- requires))
- (vector pkg-name requires docstring version-string readme)))))
+
+ pkg-desc))))
;;;###autoload
-(defun package-install-from-buffer (pkg-info type)
+(defun package-install-from-buffer (pkg-desc &optional ignore)
"Install a package from the current buffer.
When called interactively, the current buffer is assumed to be a
single .el file that follows the packaging guidelines; see info
node `(elisp)Packaging'.
-When called from Lisp, PKG-INFO is a vector describing the
-information, of the type returned by `package-buffer-info'; and
-TYPE is the package type (either `single' or `tar')."
- (interactive (list (package-buffer-info) 'single))
+When called from Lisp, PKG-DESC is a `package-desc' structure.
+
+The argument IGNORE used to specify the kind of package (single
+or tar), but that information is now contained within the
+`package-desc' structure."
+ (interactive (list (package-buffer-info)))
(save-excursion
(save-restriction
- (let* ((file-name (aref pkg-info 0))
- (requires (aref pkg-info 1))
- (desc (if (string= (aref pkg-info 2) "")
- "No description available."
- (aref pkg-info 2)))
- (pkg-version (aref pkg-info 3)))
+ (let* ((file-name (package-desc-name pkg-desc))
+ (requires (package-desc-reqs pkg-desc))
+ (pkg-version (package-desc-vers pkg-desc))
+ (kind (package-desc-kind pkg-desc)))
;; Download and install the dependencies.
(let ((transaction (package-compute-transaction nil requires)))
(package-download-transaction transaction))
;; Install the package itself.
(cond
- ((eq type 'single)
- (package-unpack-single file-name pkg-version desc requires))
- ((eq type 'tar)
- (package-unpack (intern file-name) pkg-version))
+ ((eq kind 'single)
+ (package-unpack-single (symbol-name file-name)
+ (package-version-join pkg-version)
+ (package-desc-doc pkg-desc)
+ requires))
+ ((eq kind 'tar)
+ (package-unpack (symbol-name file-name)
+ (package-version-join pkg-version)))
(t
- (error "Unknown type: %s" (symbol-name type))))
+ (error "Unknown package type: %s" kind)))
;; Try to activate it.
(package-initialize)))))
@@ -1065,9 +1120,9 @@ The file can either be a tar file or an Emacs Lisp file."
(insert-file-contents-literally file)
(cond
((string-match "\\.el$" file)
- (package-install-from-buffer (package-buffer-info) 'single))
+ (package-install-from-buffer (package-buffer-info)))
((string-match "\\.tar$" file)
- (package-install-from-buffer (package-tar-file-info file) 'tar))
+ (package-install-from-buffer (package-tar-file-info file)))
(t (error "Unrecognized extension `%s'" (file-name-extension file))))))
(defun package-delete (name version)
@@ -1085,7 +1140,7 @@ The file can either be a tar file or an Emacs Lisp file."
(defun package-archive-base (name)
"Return the archive containing the package NAME."
(let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
- (cdr (assoc (aref desc (- (length desc) 1)) package-archives))))
+ (cdr (assoc (package-desc-archive desc) package-archives))))
(defun package--download-one-archive (archive file)
"Retrieve an archive file FILE from ARCHIVE, and cache it.
@@ -1095,13 +1150,13 @@ similar to an entry in `package-alist'. Save
the cached copy to
(let* ((dir (expand-file-name "archives" package-user-dir))
(dir (expand-file-name (car archive) dir)))
(package--with-work-buffer (cdr archive) file
- ;; Read the retrieved buffer to make sure it is valid (e.g. it
- ;; may fetch a URL redirect page).
- (when (listp (read buffer))
- (make-directory dir t)
- (setq buffer-file-name (expand-file-name file dir))
- (let ((version-control 'never))
- (save-buffer))))))
+ ;; Read the retrieved buffer to make sure it is
valid (e.g. it
+ ;; may fetch a URL redirect page).
+ (when (listp (read buffer))
+ (make-directory dir t)
+ (setq buffer-file-name (expand-file-name file
dir))
+ (let ((version-control 'never))
+ (save-buffer))))))
;;;###autoload
(defun package-refresh-contents ()
@@ -1272,12 +1327,12 @@ If optional arg NO-ACTIVATE is non-nil, don't
activate packages."
(cond ((condition-case nil
(package--with-work-buffer (package-archive-base package)
(concat package-name
"-readme.txt")
- (setq buffer-file-name
- (expand-file-name readme package-user-dir))
- (let ((version-control 'never))
- (save-buffer))
- (setq readme-string (buffer-string))
- t)
+ (setq buffer-file-name
+ (expand-file-name readme
package-user-dir))
+ (let ((version-control 'never))
+ (save-buffer))
+ (setq readme-string
(buffer-string))
+ t)
(error nil))
(insert readme-string))
((file-readable-p readme)
@@ -1360,9 +1415,6 @@ If optional arg NO-ACTIVATE is non-nil, don't
activate packages."
map)
"Local keymap for `package-menu-mode' buffers.")
-(defvar package-menu--new-package-list nil
- "List of newly-available packages since `list-packages' was last called.")
-
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands.
@@ -1376,29 +1428,32 @@ Letters do not insert themselves; instead,
they are commands.
(setq tabulated-list-sort-key (cons "Status" nil))
(tabulated-list-init-header))
-(defmacro package--push (package desc status listname)
+(defmacro package--push (pkg status listname)
"Convenience macro for `package-menu--generate'.
-If the alist stored in the symbol LISTNAME lacks an entry for a
-package PACKAGE with descriptor DESC, add one. The alist is
-keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
-a symbol and VERSION-LIST is a version list."
- `(let* ((version (package-desc-vers ,desc))
- (key (cons ,package version)))
- (unless (assoc key ,listname)
- (push (list key ,status (package-desc-doc ,desc)) ,listname))))
+If the alist stored in the symbol LISTNAME lacks an entry for
+`package-desc' PKG, add one. The alist is keyed with cons
+cells (NAME . VERSION-LIST), where NAME is a symbol and
+VERSION-LIST is a version list and its value is (STATUS DOC)."
+ `(cl-pushnew (list (cons (package-desc-name ,pkg)
+ (package-desc-vers ,pkg))
+ ,status
+ (package-desc-doc ,pkg))
+ ,listname
+ :key 'car
+ :test 'equal))
(defun package-menu--generate (remember-pos packages)
"Populate the Package Menu.
If REMEMBER-POS is non-nil, keep point on the same entry.
PACKAGES should be t, which means to display all known packages,
or a list of package names (symbols) to display."
- ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
- (let (info-list name)
+ ;; Construct list of ((NAME . VERSION-LIST) STATUS DESCRIPTION)
+ (let (info-list name builtin)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
- (package--push name (cdr elt)
+ (package--push (cdr elt)
(if (stringp (cadr (assq name package-load-list)))
"held" "installed")
info-list)))
@@ -1408,52 +1463,50 @@ or a list of package names (symbols) to display."
(setq name (car elt))
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or (eq packages t) (memq name packages)))
- (package--push name (cdr elt) "built-in" info-list)))
+ (package--push (cdr elt) "built-in" info-list)))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
(setq name (car elt))
(when (or (eq packages t) (memq name packages))
(let ((hold (assq name package-load-list)))
- (package--push name (cdr elt)
- (cond
- ((and hold (null (cadr hold))) "disabled")
- ((memq name package-menu--new-package-list) "new")
- (t "available"))
+ (package--push (cdr elt)
+ (if (and hold (null (cadr hold)))
+ "disabled"
+ "available")
info-list))))
;; Obsolete packages:
(dolist (elt package-obsolete-alist)
(dolist (inner-elt (cdr elt))
(when (or (eq packages t) (memq (car elt) packages))
- (package--push (car elt) (cdr inner-elt) "obsolete" info-list))))
+ (package--push (cdr inner-elt) "obsolete" info-list))))
;; Print the result.
(setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
(tabulated-list-print remember-pos)))
-(defun package-menu--print-info (pkg)
+(defun package-menu--print-info (entry)
"Return a package entry suitable for `tabulated-list-entries'.
-PKG has the form ((PACKAGE . VERSION) STATUS DOC).
-Return (KEY [NAME VERSION STATUS DOC]), where KEY is the
+ENTRY has the form ((NAME . VERSION-LIST) STATUS DOC).
+Return (KEY [NAME VERSION-STRING STATUS DOC]), where KEY is the
identifier (NAME . VERSION-LIST)."
- (let* ((package (caar pkg))
- (version (cdr (car pkg)))
- (status (nth 1 pkg))
- (doc (or (nth 2 pkg) ""))
+ (let* ((name (caar entry))
+ (version (cdar entry))
+ (status (nth 1 entry))
+ (doc (or (nth 2 entry) ""))
(face (cond
((string= status "built-in") 'font-lock-builtin-face)
((string= status "available") 'default)
- ((string= status "new") 'bold)
((string= status "held") 'font-lock-constant-face)
((string= status "disabled") 'font-lock-warning-face)
((string= status "installed") 'font-lock-comment-face)
(t 'font-lock-warning-face)))) ; obsolete.
- (list (cons package version)
- (vector (list (symbol-name package)
+ (list (cons name version)
+ (vector (list (symbol-name name)
'face 'link
'follow-link t
- 'package-symbol package
+ 'package-symbol name
'action 'package-menu-describe-package)
(propertize (package-version-join version)
'font-lock-face face)
@@ -1480,21 +1533,21 @@ If optional arg BUTTON is non-nil, describe
its associated package."
(describe-package package))))
;; fixme numeric argument
-(defun package-menu-mark-delete (&optional _num)
+(defun package-menu-mark-delete (&optional num)
"Mark a package for deletion and move to the next line."
(interactive "p")
(if (member (package-menu-get-status) '("installed" "obsolete"))
(tabulated-list-put-tag "D" t)
(forward-line)))
-(defun package-menu-mark-install (&optional _num)
+(defun package-menu-mark-install (&optional num)
"Mark a package for installation and move to the next line."
(interactive "p")
- (if (member (package-menu-get-status) '("available" "new"))
+ (if (string-equal (package-menu-get-status) "available")
(tabulated-list-put-tag "I" t)
(forward-line)))
-(defun package-menu-mark-unmark (&optional _num)
+(defun package-menu-mark-unmark (&optional num)
"Clear any marks on a package and move to the next line."
(interactive "p")
(tabulated-list-put-tag " " t))
@@ -1534,12 +1587,12 @@ If optional arg BUTTON is non-nil, describe
its associated package."
(let (installed available upgrades)
;; Build list of installed/available packages in this buffer.
(dolist (entry tabulated-list-entries)
- ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC])
+ ;; ENTRY is ((NAME . VERSION-LIST) [NAME VERSION-STRING STATUS DOC])
(let ((pkg (car entry))
(status (aref (cadr entry) 2)))
(cond ((equal status "installed")
(push pkg installed))
- ((member status '("available" "new"))
+ ((equal status "available")
(push pkg available)))))
;; Loop through list of installed packages, finding upgrades
(dolist (pkg installed)
@@ -1645,18 +1698,16 @@ packages marked for deletion are removed."
(sB (aref (cadr B) 2)))
(cond ((string= sA sB)
(package-menu--name-predicate A B))
- ((string= sA "new") t)
- ((string= sB "new") nil)
- ((string= sA "available") t)
+ ((string= sA "available") t)
((string= sB "available") nil)
- ((string= sA "installed") t)
+ ((string= sA "installed") t)
((string= sB "installed") nil)
- ((string= sA "held") t)
+ ((string= sA "held") t)
((string= sB "held") nil)
- ((string= sA "built-in") t)
+ ((string= sA "built-in") t)
((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
(t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
@@ -1681,36 +1732,22 @@ The list is displayed in a buffer named `*Packages*'."
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
- (let (old-archives new-packages)
- (unless no-fetch
- ;; Read the locally-cached archive-contents.
- (package-read-all-archive-contents)
- (setq old-archives package-archive-contents)
- ;; Fetch the remote list of packages.
- (package-refresh-contents)
- ;; Find which packages are new.
- (dolist (elt package-archive-contents)
- (unless (assq (car elt) old-archives)
- (push (car elt) new-packages))))
-
- ;; Generate the Package Menu.
- (let ((buf (get-buffer-create "*Packages*")))
- (with-current-buffer buf
- (package-menu-mode)
- (set (make-local-variable 'package-menu--new-package-list)
- new-packages)
- (package-menu--generate nil t))
- ;; The package menu buffer has keybindings. If the user types
- ;; `M-x list-packages', that suggests it should become current.
- (switch-to-buffer buf))
-
- (let ((upgrades (package-menu--find-upgrades)))
- (if upgrades
- (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]")
- (if (= (length upgrades) 1) "it" "them"))))))
+ (unless no-fetch
+ (package-refresh-contents))
+ (let ((buf (get-buffer-create "*Packages*")))
+ (with-current-buffer buf
+ (package-menu-mode)
+ (package-menu--generate nil t))
+ ;; The package menu buffer has keybindings. If the user types
+ ;; `M-x list-packages', that suggests it should become current.
+ (switch-to-buffer buf))
+ (let ((upgrades (package-menu--find-upgrades)))
+ (if upgrades
+ (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]")
+ (if (= (length upgrades) 1) "it" "them")))))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
- [PATCH] Re: package.el changes before the feature freeze,
Daniel Hackney <=
- Re: [PATCH] Re: package.el changes before the feature freeze, Chong Yidong, 2012/10/04
- Re: [PATCH] Re: package.el changes before the feature freeze, Daniel Hackney, 2012/10/05
- Re: [PATCH] Re: package.el changes before the feature freeze, Stefan Monnier, 2012/10/05
- Re: [PATCH] Re: package.el changes before the feature freeze, Chong Yidong, 2012/10/07
- Re: [PATCH] Re: package.el changes before the feature freeze, Daniel Hackney, 2012/10/08
- Re: [PATCH] Re: package.el changes before the feature freeze, Stefan Monnier, 2012/10/08
- Re: [PATCH] Re: package.el changes before the feature freeze, Daniel Hackney, 2012/10/08
- Re: [PATCH] Re: package.el changes before the feature freeze, Stefan Monnier, 2012/10/09
- Re: [PATCH] Re: package.el changes before the feature freeze, Daniel Hackney, 2012/10/09
- Re: [PATCH] Re: package.el changes before the feature freeze, Stefan Monnier, 2012/10/09