* package.el changes before the feature freeze @ 2012-09-30 16:58 Daniel Hackney 2012-09-30 20:21 ` Stefan Monnier 2012-10-01 3:11 ` Chong Yidong 0 siblings, 2 replies; 20+ messages in thread From: Daniel Hackney @ 2012-09-30 16:58 UTC (permalink / raw) To: emacs-devel I hadn't known about the feature freeze until I checked the mailing list yesterday. I'm working on changes to package.el to make it more flexible and resolve some of the existing problems it has (failing installs with "file exists," leftover -autoloads.el files, including elisp files in nested directories, enabling gzipped tarballs, etc.). I have the basic infrastructure in place, but need to test it before I'd be comfortable having people use it. Not all of those features will be done soon, but much of the refactored base (using `defstruct' for package descriptors instead of the variety of `cons'ed vectors) is in place. Could I get a few extra days to get this tested? My work is here: https://github.com/haxney/package P.S. I am not subscribed to the list, so please CC me in any replies. -- Daniel Hackney ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: package.el changes before the feature freeze 2012-09-30 16:58 package.el changes before the feature freeze Daniel Hackney @ 2012-09-30 20:21 ` Stefan Monnier 2012-09-30 23:50 ` Daniel Hackney 2012-10-01 3:11 ` Chong Yidong 1 sibling, 1 reply; 20+ messages in thread From: Stefan Monnier @ 2012-09-30 20:21 UTC (permalink / raw) To: Daniel Hackney; +Cc: emacs-devel > base (using `defstruct' for package descriptors instead of the variety Before I look any closer, can you please change your code to use `cl-lib' instead of `cl' (this mostly means you'll need to add a "cl-" prefix to all the CL macros and functions you use). Also, please send your change as a patch so it's easier to see what's changed. Stefan ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: package.el changes before the feature freeze 2012-09-30 20:21 ` Stefan Monnier @ 2012-09-30 23:50 ` Daniel Hackney 2012-10-01 1:21 ` Stefan Monnier 0 siblings, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-09-30 23:50 UTC (permalink / raw) To: Stefan Monnier; +Cc: emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> wrote: >> base (using `defstruct' for package descriptors instead of the variety > > Before I look any closer, can you please change your code to use > `cl-lib' instead of `cl' (this mostly means you'll need to add a "cl-" > prefix to all the CL macros and functions you use). Sure thing. I've been developing this under 24.2 and so didn't have access to those libraries. > Also, please send your change as a patch so it's easier to see > what's changed. I can do that for the package.el code I have now. From my basic manual tests, things seem to work out alright and I have been careful to ensure that it can handle all of the existing formats without modification. It utilizes the same "archive-contents" and "foo-pkg.el" files as the current version. I can make the cl => cl-lib conversion and patchify the result. Is it okay to submit a patch whose stability I cannot guarantee? I'd hate to ruin someone's day if they are relying on the dev branch for day-to-day work. -- Daniel Hackney ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: package.el changes before the feature freeze 2012-09-30 23:50 ` Daniel Hackney @ 2012-10-01 1:21 ` Stefan Monnier 0 siblings, 0 replies; 20+ messages in thread From: Stefan Monnier @ 2012-10-01 1:21 UTC (permalink / raw) To: Daniel Hackney; +Cc: emacs-devel > I can make the cl => cl-lib conversion and patchify the result. Is it > okay to submit a patch whose stability I cannot guarantee? Of course, especially since I thnk people will first want to look at the patch anyway. > I'd hate to ruin someone's day if they are relying on the dev branch > for day-to-day work. Breakage on the trunk happens. That's why we have releases. Stefan ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: package.el changes before the feature freeze 2012-09-30 16:58 package.el changes before the feature freeze Daniel Hackney 2012-09-30 20:21 ` Stefan Monnier @ 2012-10-01 3:11 ` Chong Yidong 2012-10-03 0:33 ` Daniel Hackney 2012-10-03 22:41 ` [PATCH] " Daniel Hackney 1 sibling, 2 replies; 20+ messages in thread From: Chong Yidong @ 2012-10-01 3:11 UTC (permalink / raw) To: Daniel Hackney; +Cc: emacs-devel Daniel Hackney <dan@haxney.org> writes: > Not all of those features will be done soon, but much of the > refactored base (using `defstruct' for package descriptors instead of > the variety of `cons'ed vectors) is in place. Could I get a few extra > days to get this tested? How much time are you asking for? I'm wary of big changes to package.el (where backward incompatibilities can cause huge headaches) coming out of the blue right before a feature freeze. I took a look at your code, but the changes are too pervasive to easily review, and trying to load the code caused M-x list-packages to spin for a long time followed by Debugger entered--Lisp error: (void-function cl-adjoin) cl-adjoin(((debbugs 0 3) "installed" "SOAP library to access debbugs servers") nil :key car) package-menu--generate(nil t) list-packages(nil) call-interactively(list-packages record nil) I have the debbugs library installed, so I'm guessing your changes screw up existing package installations somehow. Have you altered the on-disk format of installed packages (such as directory layout, the contents of archive-contents, etc.)? If so, I don't think it's suitable for 24.3. Maybe you should split off some of the smaller parts of your altered package.el and commit those separately, saving the rest for post-24.3. ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: package.el changes before the feature freeze 2012-10-01 3:11 ` Chong Yidong @ 2012-10-03 0:33 ` Daniel Hackney 2012-10-03 22:41 ` [PATCH] " Daniel Hackney 1 sibling, 0 replies; 20+ messages in thread From: Daniel Hackney @ 2012-10-03 0:33 UTC (permalink / raw) To: Chong Yidong; +Cc: emacs-devel Chong Yidong <cyd@gnu.org> wrote: > Daniel Hackney <dan@haxney.org> writes: > >> Not all of those features will be done soon, but much of the >> refactored base (using `defstruct' for package descriptors instead of >> the variety of `cons'ed vectors) is in place. Could I get a few extra >> days to get this tested? > > How much time are you asking for? I'm wary of big changes to package.el > (where backward incompatibilities can cause huge headaches) coming out > of the blue right before a feature freeze. I'll try to have it done by the end of the week. If I don't have something stable enough to pull by Sunday (at the latest), go on ahead without me. I hadn't been following the mailing list closely, so I didn't find out about the feature freeze until just before I sent the email. > I took a look at your code, but the changes are too pervasive to easily > review, and trying to load the code caused M-x list-packages to spin for > a long time followed by > > Debugger entered--Lisp error: (void-function cl-adjoin) > cl-adjoin(((debbugs 0 3) "installed" "SOAP library to access debbugs servers") nil :key car) > package-menu--generate(nil t) > list-packages(nil) > call-interactively(list-packages record nil) Weird. I'll take a look at that now. > I have the debbugs library installed, so I'm guessing your changes screw > up existing package installations somehow. I tried to avoid having my change mess with that, but I'll check on the latest dev version. > Have you altered the on-disk > format of installed packages (such as directory layout, the contents of > archive-contents, etc.)? If so, I don't think it's suitable for 24.3. Nope. All of the on-disk stuff is the same. I knew that on-disk changes would be too invasive and so left the externally-facing stuff untouched. Apparently I didn't do so well enough. > Maybe you should split off some of the smaller parts of your altered > package.el and commit those separately, saving the rest for post-24.3. The essence of the change was unifying the types used. Right now, the package description floats through the program in a couple different formats which I thought could be combined into one. -- Daniel Hackney ^ permalink raw reply [flat|nested] 20+ messages in thread
* [PATCH] Re: package.el changes before the feature freeze 2012-10-01 3:11 ` Chong Yidong 2012-10-03 0:33 ` Daniel Hackney @ 2012-10-03 22:41 ` Daniel Hackney 2012-10-04 8:16 ` Chong Yidong 1 sibling, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-10-03 22:41 UTC (permalink / raw) To: Chong Yidong; +Cc: emacs-devel 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 <tromey@redhat.com> ;; 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 <dan@haxney.org> ;; Jim Blandy <jimb@red-bean.com> ;; Karl Fogel <kfogel@red-bean.com> ;; Kevin Ryde <user42@zip.com.au> ;; Lawrence Mitchell ;; Michael Olson <mwolson@member.fsf.org> +;; Phil Hagelberg <phil@hagelb.org> ;; Sebastian Tennant <sebyte@smolny.plus.com> ;; Stefan Monnier <monnier@iro.umontreal.ca> ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> -;; Phil Hagelberg <phil@hagelb.org> -;;; 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) ^ permalink raw reply related [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-03 22:41 ` [PATCH] " Daniel Hackney @ 2012-10-04 8:16 ` Chong Yidong 2012-10-05 23:13 ` Daniel Hackney 0 siblings, 1 reply; 20+ messages in thread From: Chong Yidong @ 2012-10-04 8:16 UTC (permalink / raw) To: Daniel Hackney; +Cc: emacs-devel In general, I find this patch very difficult to review. As just one example, you made a big change to `list-packages' by making it no longer call package-read-all-archive-contents, but there is no justification or explanation given, and appears to have nothing to do with the defstruct cleanup. Could you break it up into several different patches, each doing one thing? Here are some comments from a quick skim through the patch: > -;; Version: 1.0 > +;; Version: 1.5 Why the jump of 0.4 versions? > -;; GNU Emacs is free software: you can redistribute it and/or modify > +;; GNU Emacs is free software; you can redistribute it and/or modify Please get rid of such differences, they make the patch harder to read. > - :value-type (string :tag "URL or directory name")) > + :value-type (string :tag "URL or directory name")) Likewise, please get rid of whitespace differences. > +;; 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)) > ... > +(defvar package-builtins-newified nil Please get rid of these functions and their callers, and all the newify stuff. Instead, change `finder-compile-keywords' in finder.el to use the defstruct format and include it in the patch. > (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) Why did you get rid of the "new" status? Also, you added more gratuitous whitespace differences to this function. > -(defun package-menu-mark-unmark (&optional _num) > +(defun package-menu-mark-unmark (&optional num) Why? ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-04 8:16 ` Chong Yidong @ 2012-10-05 23:13 ` Daniel Hackney 2012-10-06 1:38 ` Stefan Monnier 0 siblings, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-10-05 23:13 UTC (permalink / raw) To: Chong Yidong; +Cc: emacs-devel Chong Yidong <cyd@gnu.org> wrote: > In general, I find this patch very difficult to review. As just one > example, you made a big change to `list-packages' by making it no longer > call package-read-all-archive-contents, but there is no justification or > explanation given, and appears to have nothing to do with the defstruct > cleanup. I think there were a number of things which I failed to pull from upstream, so they showed up as being removed in my patch despite my intentions. The "new" status for packages, for example, was not present in the 24.2 version of package.el and so got wiped out in my patch. I'm doing a more careful merge, starting with the clean 24.2.50 package.el and adding my stuff on top. Hopefully that will help things. > Could you break it up into several different patches, each doing one > thing? Taking a closer look at the individual components, I realized how much non-defstruct-related stuff I was adding. I've torn that all out. > Here are some comments from a quick skim through the patch: > >> -;; Version: 1.0 >> +;; Version: 1.5 > > Why the jump of 0.4 versions? I'm not really sure. Would it be appropriate for me to bump the version, say to either 1.1 or 2.0? >> -;; GNU Emacs is free software: you can redistribute it and/or modify >> +;; GNU Emacs is free software; you can redistribute it and/or modify > > Please get rid of such differences, they make the patch harder to read. Done. I've killed all whitespace-only lines. Sorry about that. >> +;; 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)) >> ... >> +(defvar package-builtins-newified nil > > Please get rid of these functions and their callers, and all the newify > stuff. Instead, change `finder-compile-keywords' in finder.el to use > the defstruct format and include it in the patch. I was writing my patch to be runnable on an out-of-the-box copy of 24.2. I shouldn't have submitted that (horrible ugliness) in a patch to the core. >> -(defun package-menu-mark-unmark (&optional _num) >> +(defun package-menu-mark-unmark (&optional num) > > Why? My aesthetic perfectionism got the best of me, but that's not a legitimate reason to introduce useless noise into the patch. I've reverted it. This latest version only changes function and docstring variable names in cases where doing so makes the types clearer. I've replaced most instances of "version" with either "version-list" or "version-string" to clear up which form is used for each function. Take 2. Hopefully this is more useful. Again, I've hosted it separately in case email decides to hate me: https://github.com/downloads/haxney/package/package-defstruct-2.diff diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 28d1662..a04fb33 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -169,6 +169,8 @@ ;;; Code: +(require 'cl-lib) + (require 'tabulated-list) (defgroup package nil @@ -244,11 +246,8 @@ Lower version numbers than this will probably be understood as well.") ;; 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 +278,51 @@ 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 summary requirements + &key kind archive + &aux (name (intern name-string)) + (version (ignore-errors (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. + +Slots: + +`:name' +Name of the package, as a symbol. + +`:version' +Version of the package, as a version list. + +`:summary' +Short description of the package, typically taken from the first +line of the file. + +`:reqs' +Requirements of the package. A list of (PACKAGE VERSION-LIST) +naming the dependent package and the minimum required version. + +`:kind' +The distribution format of the package. Currently, it is either +`single' or `tar'. + +`:archive' +The name of the archive (as a string) whence this package came." + + name + version + (summary "No description available.") + reqs + kind + archive) + ;; 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 +332,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 @@ -321,7 +352,10 @@ 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.") +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) @@ -412,22 +446,6 @@ 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)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) - (defun package--dir (name version) "Return the directory where a package is installed, or nil if none. NAME and VERSION are both strings." @@ -442,9 +460,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-version pkg-desc))) (pkg-dir (package--dir name version-str))) (unless pkg-dir (error "Internal error: unable to find directory for `%s-%s'" @@ -457,8 +475,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)) @@ -471,7 +489,7 @@ specifying the minimum acceptable version." (version-list-<= min-version (version-to-list emacs-version)) (let ((elt (assq package package--builtins))) (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) + (package-desc-version (cdr elt))))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at @@ -482,11 +500,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-version pkg-desc) found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. @@ -499,7 +517,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,29 +525,29 @@ 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-version 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 + &optional summary 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. -DOCSTRING is a short description of the package, a string. +SUMMARY is a short description of the package, a string. 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. @@ -539,29 +557,28 @@ EXTRA-PROPERTIES is currently unused." (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 + summary + requirements + _extra-properties))) (old-pkg (assq name package-alist))) (cond ;; If there's no old package, just add this to `package-alist'. ((null old-pkg) (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) + ((version-list-< (package-desc-version (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 ;; the system package directory and one in your private ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) + ((not (version-list-= (package-desc-version (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) @@ -608,9 +625,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? @@ -633,7 +651,9 @@ PKG-DIR is the name of the package directory." (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." + "Install the contents of the current buffer as a package. + +FILE-NAME, VERSION, and DESC must be strings." ;; Special case "package". (if (string= file-name "package") (package--write-file-no-coding @@ -723,7 +743,7 @@ It will move point to somewhere in the headers." (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. @@ -731,7 +751,7 @@ MIN-VERSION should be a version list." (let ((pkg-desc (assq package package-alist))) (if pkg-desc (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. (package-built-in-p package min-version)))) @@ -754,7 +774,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)) @@ -774,18 +794,18 @@ but version %s required" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version 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))))) + (package-version-join (package-desc-version 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) @@ -828,8 +848,6 @@ If successful, set `package-archive-contents'." "Re-read archive contents for ARCHIVE. If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." - ;; Version 1 of 'archive-contents' is identical to our internal - ;; representation. (let* ((dir (concat "archives/" archive)) (contents-file (concat dir "/archive-contents")) contents) @@ -839,16 +857,21 @@ If the archive version is too new, signal an error." (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))) +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (pkg-desc + (make-package-desc :name name + :version (aref (cdr package) 0) + :reqs (aref (cdr package) 1) + :summary (aref (cdr package) 2) + :kind (aref (cdr package) 3) + :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) + ((version-list-< (package-desc-version (cdr existing-package)) + (package-desc-version pkg-desc)) ;; Replace the entry with this one. (setq package-archive-contents (cons entry @@ -867,14 +890,14 @@ using `package-compute-transaction'." ;; `package-load-list', download the held version. (hold (cadr (assq elt package-load-list))) (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) + (package-version-join (package-desc-version desc)))) (kind (package-desc-kind desc))) (cond ((eq kind 'tar) (package-download-tar elt v-string)) ((eq kind 'single) (package-download-single elt v-string - (package-desc-doc desc) + (package-desc-summary desc) (package-desc-reqs desc))) (t (error "Unknown package kind: %s" (symbol-name kind)))) @@ -928,17 +951,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 +981,18 @@ 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 + :kind 'single)))) (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'." + "Build a `package-desc' from the contents of a tar file. +Looks for a \"foo-pkg.el\" file in the tar file which must +contain a package definition." (let ((default-directory (file-name-directory file)) (file (file-name-nondirectory file))) (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") @@ -998,61 +1010,47 @@ 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 ((pkg-desc (apply #'define-package-desc (cdr pkg-def-parsed) '(:kind tar)))) + (unless (equal (package-version-join (package-desc-version 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) "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." + (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 (symbol-name (package-desc-name pkg-desc))) + (requires (package-desc-reqs pkg-desc)) + (pkg-version (package-desc-version 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 file-name + (package-version-join pkg-version) + (package-desc-summary pkg-desc) + requires)) + ((eq kind 'tar) + (package-unpack file-name + (package-version-join pkg-version))) (t - (error "Unknown type: %s" (symbol-name type)))) + (error "Unknown package type: %s" (symbol-name kind)))) ;; Try to activate it. (package-initialize))))) @@ -1065,9 +1063,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 +1083,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. @@ -1130,7 +1128,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt) (package-desc-version (cdr elt))))) (setq package--initialized t)) \f @@ -1177,21 +1175,21 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (cond ;; Loaded packages are in `package-alist'. ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) + (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package--dir package-name version)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) + (setq version (package-version-join (package-desc-version desc)) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1250,7 +1248,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. @@ -1376,29 +1374,38 @@ 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. The values of LISTNAME are lists +of STATUS and the package summary. + +LISTNAME looks like this: + +\( ((foo . (1 2 3)) + (status summary)) ... )" + `(cl-pushnew (list (cons (package-desc-name ,pkg) + (package-desc-version ,pkg)) + ,status + (package-desc-summary ,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,14 +1415,14 @@ 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) + (package--push (cdr elt) (cond ((and hold (null (cadr hold))) "disabled") ((memq name package-menu--new-package-list) "new") @@ -1426,21 +1433,21 @@ or a list of package names (symbols) to display." (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 SUMMARY). +Return (KEY [NAME VERSION-STRING STATUS SUMMARY]), 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)) + (summary (or (nth 2 entry) "")) (face (cond ((string= status "built-in") 'font-lock-builtin-face) ((string= status "available") 'default) @@ -1449,16 +1456,16 @@ identifier (NAME . VERSION-LIST)." ((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) (propertize status 'font-lock-face face) - (propertize doc 'font-lock-face face))))) + (propertize summary 'font-lock-face face))))) (defun package-menu-refresh () "Download the Emacs Lisp package archive. @@ -1534,7 +1541,7 @@ 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 SUMMARY]) (let ((pkg (car entry)) (status (aref (cadr entry) 2))) (cond ((equal status "installed") diff --git a/lisp/finder.el b/lisp/finder.el index 6ccb4bf..5010c8b 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -205,12 +205,16 @@ from; the default is `load-path'." (setq version (ignore-errors (version-to-list version))) (setq entry (assq package package--builtins)) (cond ((null entry) - (push (cons package (vector version nil summary)) + (push (cons package (make-package-desc + :name package + :version version + :summary summary + :kind 'builtin)) package--builtins)) ((eq base-name package) (setq desc (cdr entry)) - (aset desc 0 version) - (aset desc 2 summary))) + (setf (package-desc-version desc) version + (package-desc-summary desc) summary))) (dolist (kw keywords) (puthash kw (cons package ^ permalink raw reply related [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-05 23:13 ` Daniel Hackney @ 2012-10-06 1:38 ` Stefan Monnier 2012-10-08 2:32 ` Chong Yidong 2012-10-08 19:16 ` Daniel Hackney 0 siblings, 2 replies; 20+ messages in thread From: Stefan Monnier @ 2012-10-06 1:38 UTC (permalink / raw) To: Daniel Hackney; +Cc: Chong Yidong, emacs-devel I haven't read the whole patch, but here are some nitpicks. The general idea looks fine, tho. We'd need a ChangeLog with that, it should describe the changes that are neither cosmetic nor simple adjustments to the use of defstruct. Stefan > +Slots: > + > +`:name' > +Name of the package, as a symbol. > + > +`:version' > +Version of the package, as a version list. > + > +`:summary' > +Short description of the package, typically taken from the first > +line of the file. > + > +`:reqs' > +Requirements of the package. A list of (PACKAGE VERSION-LIST) > +naming the dependent package and the minimum required version. > + > +`:kind' > +The distribution format of the package. Currently, it is either > +`single' or `tar'. > + > +`:archive' > +The name of the archive (as a string) whence this package came." > + > + name > + version > + (summary "No description available.") > + reqs > + kind > + archive) Nitpick: the fields of the struct (which you can call "slots" if you prefer, of course) don't have a ":" in front of their name. [ I'd also prefer using fewer lines in the docstring, so the whole definition can hopefully fit within a tall-but-split frame. ] > -(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-version pkg-desc))) > (pkg-dir (package--dir name version-str))) Hmm... `name' in the new code is now a symbol whereas it was a string in the old code. Is that right? > - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) > + (load (expand-file-name (concat (symbol-name name) "-autoloads") > pkg-dir) nil t) You can use (format "%s-autoloads" name) to make it work equally with strings and symbols. > + (apply 'define-package-desc BTW,please stick to the "package-" prefix. > + name-string > + version-string > + summary > + requirements > + _extra-properties))) Obviously you haven't played with lexical-binding yet, but the "leading underscore" is used to denote variables/arguments that are not used, so the above use of _extra-properties indicates that it should be named `extra-properties' instead. > - (package-unpack name version)))) > + (package-unpack (symbol-name name) version)))) All those make me wonder: do we need the `name' slot to be symbol? Why not let it be a string? > + (make-package-desc :name name I know it's the default, but I also prefer not to use the "make-" prefix and use "package-" as the prefix instead. ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-06 1:38 ` Stefan Monnier @ 2012-10-08 2:32 ` Chong Yidong 2012-10-08 19:16 ` Daniel Hackney 1 sibling, 0 replies; 20+ messages in thread From: Chong Yidong @ 2012-10-08 2:32 UTC (permalink / raw) To: Stefan Monnier; +Cc: Daniel Hackney, emacs-devel > All those make me wonder: do we need the `name' slot to be symbol? > Why not let it be a string? Using symbols for package names makes sense conceptually, since a package name is often the same as the package's library prefix (e.g. debbugs) or a particular command provided by the library (e.g. nhexl-mode). So you'd practically never want to use a package name that isn't also a good symbol name. Also, it lets package.el uses assq rather than assoc in several places, which is always nice. ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-06 1:38 ` Stefan Monnier 2012-10-08 2:32 ` Chong Yidong @ 2012-10-08 19:16 ` Daniel Hackney 2012-10-08 19:50 ` Stefan Monnier 1 sibling, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-10-08 19:16 UTC (permalink / raw) To: Stefan Monnier; +Cc: Chong Yidong, emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> wrote: > I haven't read the whole patch, but here are some nitpicks. > The general idea looks fine, tho. We'd need a ChangeLog with that, > it should describe the changes that are neither cosmetic nor simple > adjustments to the use of defstruct. Okay. I'll take a look at existing ChangeLog entries and try to duplicate the style and format. >> +Slots: >> + >> +`:name' >> +Name of the package, as a symbol. >> + >> +`:version' >> +Version of the package, as a version list. >> + >> +`:summary' >> +Short description of the package, typically taken from the first >> +line of the file. >> + >> +`:reqs' >> +Requirements of the package. A list of (PACKAGE VERSION-LIST) >> +naming the dependent package and the minimum required version. >> + >> +`:kind' >> +The distribution format of the package. Currently, it is either >> +`single' or `tar'. >> + >> +`:archive' >> +The name of the archive (as a string) whence this package came." >> + >> + name >> + version >> + (summary "No description available.") >> + reqs >> + kind >> + archive) > > Nitpick: the fields of the struct (which you can call "slots" if you > prefer, of course) don't have a ":" in front of their name. The CL info pages refer to them as slots, so that's what I figured I'd use. There could be a better name for a package defstruct, but "field" "property" and "attribute" are overdone :) True. I was basing that off of the fact that calling `make-package-desc' requires passing in the slot names as `:'-prefixed symbols. I guess that's a different issue; I'll change them to the un-prefixed version. > [ I'd also prefer using fewer lines in the docstring, so the whole > definition can hopefully fit within a tall-but-split frame. ] I changed the slot documentation so that the name and the start of the description start on the same line. >> -(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-version pkg-desc))) >> (pkg-dir (package--dir name version-str))) > > Hmm... `name' in the new code is now a symbol whereas it was a string in > the old code. Is that right? That's right. Like Chong said, what I'm calling `name' now is `assq'ed all over the place, so it's a matter of using `symbol-name' or `intern' in a bunch of places. Symbols feel more "canonical-y" to me. I agree that the slot name could definitely be improved. `name' does imply a string to me, but I think that it is good for the "primary key" of the alists to be a symbol. Something like `canonical-name' perhaps? `id' maybe? I'm not terribly attached to any particular slot name. >> - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) >> + (load (expand-file-name (concat (symbol-name name) "-autoloads") >> pkg-dir) nil t) > > You can use (format "%s-autoloads" name) to make it work equally with > strings and symbols. I think the reason I used the `concat' was to reduce the changes the patch introduced. I'll switch to `format'. >> + (apply 'define-package-desc > > BTW,please stick to the "package-" prefix. This was intended to be related to `define-package'; it turns the `define-package' call into a `package-desc' struct. Since `define-package' is part of the externally-facing API, it cannot change. I suppose because `define-package' from the "foo-pkg.el" file isn't being `eval'd, there doesn't actually need to be a function named `define-package'. Do you want me to change that back to a call to `make-package-desc'? >> + name-string >> + version-string >> + summary >> + requirements >> + _extra-properties))) > > Obviously you haven't played with lexical-binding yet, but the "leading > underscore" is used to denote variables/arguments that are not used, so > the above use of _extra-properties indicates that it should be named > `extra-properties' instead. I haven't looked at lexical binding in earnest. Should I reference the non-prefixed form in the body of `define-package'? >> - (package-unpack name version)))) >> + (package-unpack (symbol-name name) version)))) > > All those make me wonder: do we need the `name' slot to be symbol? > Why not let it be a string? Actually, switching the `concat's to `format's means that there is much less of a need for explicit `symbol-name's. I'll see if I can get the functions passing around a symbol only >> + (make-package-desc :name name > > I know it's the default, but I also prefer not to use the "make-" prefix > and use "package-" as the prefix instead. Sure thing. ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-08 19:16 ` Daniel Hackney @ 2012-10-08 19:50 ` Stefan Monnier 2012-10-09 1:11 ` Daniel Hackney 0 siblings, 1 reply; 20+ messages in thread From: Stefan Monnier @ 2012-10-08 19:50 UTC (permalink / raw) To: Daniel Hackney; +Cc: Chong Yidong, emacs-devel > The CL info pages refer to them as slots, so that's what I figured I'd > use. There could be a better name for a package defstruct, but "field" > "property" and "attribute" are overdone :) Sure, use whatever suits you. > I agree that the slot name could definitely be improved. `name' does > imply a string to me, but I think that it is good for the "primary key" > of the alists to be a symbol. Something like `canonical-name' perhaps? > `id' maybe? I'm not terribly attached to any particular slot name. `name' is no worse than the others, so just use that. > This was intended to be related to `define-package'; it turns the > `define-package' call into a `package-desc' struct. I understand the motivation, but the use of a "package-" prefix is more important, I think. > I haven't looked at lexical binding in earnest. Should I reference > the non-prefixed form in the body of `define-package'? The symbols prefixed by "_" are not treated specially by the compiler/evaluator. The use of _ only affects the warnings you might get (where a `_foo' that is used or a `foo' that is not used will signal a warning) and the way things are displayed in *Help* (where the underscore is stripped, since whether or not an argument is used is an implementation detail). Stefan ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-08 19:50 ` Stefan Monnier @ 2012-10-09 1:11 ` Daniel Hackney 2012-10-09 6:48 ` Stefan Monnier 0 siblings, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-10-09 1:11 UTC (permalink / raw) To: Stefan Monnier; +Cc: Chong Yidong, emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> wrote: >> The CL info pages refer to them as slots, so that's what I figured I'd >> use. There could be a better name for a package defstruct, but "field" >> "property" and "attribute" are overdone :) > > Sure, use whatever suits you. > >> I agree that the slot name could definitely be improved. `name' does >> imply a string to me, but I think that it is good for the "primary key" >> of the alists to be a symbol. Something like `canonical-name' perhaps? >> `id' maybe? I'm not terribly attached to any particular slot name. > > `name' is no worse than the others, so just use that. > >> This was intended to be related to `define-package'; it turns the >> `define-package' call into a `package-desc' struct. > > I understand the motivation, but the use of a "package-" prefix is > more important, I think. > >> I haven't looked at lexical binding in earnest. Should I reference >> the non-prefixed form in the body of `define-package'? > > The symbols prefixed by "_" are not treated specially by the > compiler/evaluator. The use of _ only affects the warnings you might > get (where a `_foo' that is used or a `foo' that is not used will signal > a warning) and the way things are displayed in *Help* (where the > underscore is stripped, since whether or not an argument is used is an > implementation detail). I replaced most of the instances of `concat' with `format' which means that there is almost no use of `symbol-name' (since it is being done within `format'). I also further standardized the naming of arguments; NAME for the package name (as a symbol), SUMMARY for the one-line description, and a couple others. Everything uses the "package-*" prefix, and `define-package' has been removed entirely. The "foo-pkg.el" files are no longer `load'ed directly. Instead, they are read with `package-read-from-string' and the cdr is sent to `package-desc-from-define', which has the same signature as the old `package-define'. Version 3 includes a basic test suite which exercises package installing, both through lisp (`package-install-file') and through the menu. Both single- and multi-file packages are covered, as is reading from an "archive-contents" file. I haven't tested package deleting, obsoleting, or upgrading, but, aside from name changes, I haven't done much to disturb that part of the code. That would be the next big thing I'd want to tackle. Patch follows, with static version available here: https://github.com/downloads/haxney/emacs/package-defstruct3.diff Patch contents: diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 28d1662..602f6c8 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -169,6 +169,8 @@ ;;; Code: +(require 'cl-lib) + (require 'tabulated-list) (defgroup package nil @@ -244,11 +246,8 @@ Lower version numbers than this will probably be understood as well.") ;; 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 +278,50 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") +(cl-defstruct (package-desc + ;; Rename the default constructor from `make-package-desc'. + (:constructor package-desc-create) + ;; Has the same interface as the old `define-package', + ;; which is still used in the "foo-pkg.el" files. Extra + ;; options can be supported by adding additional keys. + (:constructor + package-desc-from-define + (name-string version-string &optional summary requirements + &key kind archive + &aux (name (intern name-string)) + (version (ignore-errors (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. + +Slots: + +`name' Name of the package, as a symbol. + +`version' Version of the package, as a version list. + +`summary' Short description of the package, typically taken from +the first line of the file. + +`reqs' Requirements of the package. A list of (PACKAGE +VERSION-LIST) naming the dependent package and the minimum +required version. + +`kind' The distribution format of the package. Currently, it is +either `single' or `tar'. + +`archive' The name of the archive (as a string) whence this +package came." + name + version + (summary "No description available.") + reqs + kind + archive) + ;; 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 +331,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 @@ -321,7 +351,10 @@ 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.") +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) @@ -359,17 +392,50 @@ E.g., if given \"quux-23.0\", will return \"quux\"" (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname) (match-string 1 dirname))) -(defun package-load-descriptor (dir package) - "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VERSION, where NAME is -the package name and VERSION is its version." - (let* ((pkg-dir (expand-file-name package dir)) +(defun package-load-descriptor (name version dir) + "Load the description file in directory DIR for package NAME. +NAME is the package name as a symbol and VERSION must be a +string." + (let* ((old-pkg (cdr-safe (assq name package-alist))) + (pkg-dir (expand-file-name (format "%s-%s" name version) dir)) (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"))) - (load pkg-file nil t)))) + (format "%s-pkg.el" name) + pkg-dir)) + (pkg-def-contents (with-temp-buffer + (insert-file-literally pkg-file) + (buffer-string))) + (pkg-def-parsed (package-read-from-string pkg-def-contents)) + pkg-desc) + + (unless (eq (car pkg-def-parsed) 'define-package) + (error "No `define-package' sexp is present in `%s-pkg.el'" name)) + + (setq pkg-desc (apply #'package-desc-from-define + (append (cdr pkg-def-parsed) '(:kind tar)))) + (unless (equal (package-version-join (package-desc-version pkg-desc)) + version) + (error "Package has inconsistent versions")) + (unless (eq (package-desc-name pkg-desc) name) + (error "Package has inconsistent names")) + + (cond + ;; If there's no old package, just add this to `package-alist'. + ((null old-pkg) + (push (cons name pkg-desc) package-alist)) + ((version-list-< (package-desc-version old-pkg) + (version-to-list version)) + ;; Remove the old package and declare it obsolete. + (package-mark-obsolete old-pkg) + (cl-delete (package-desc-name old-pkg) package-alist :key 'car) + (push package-alist (cons name pkg-desc))) + ;; You can have two packages with the same version, e.g. one in + ;; the system package directory and one in your private + ;; directory. We just let the first one win. + ((not (version-list-= (package-desc-version old-pkg) + (version-to-list version))) + ;; The package is born obsolete. + (package-mark-obsolete pkg-desc))) + pkg-desc)) (defun package-load-all-descriptors () "Load descriptors for installed Emacs Lisp packages. @@ -385,17 +451,17 @@ updates `package-alist' and `package-obsolete-alist'." (when (file-directory-p dir) (dolist (subdir (directory-files dir)) (when (string-match regexp subdir) - (package-maybe-load-descriptor (match-string 1 subdir) + (package-maybe-load-descriptor (intern (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))) +NAME is the package name as a symbol and VERSION is the package's +version string. This function checks `package-load-list', before +actually loading the package by calling`package-load-descriptor'." + (let ((force (assq name package-load-list)) + (subdir (format "%s-%s" name version))) (and (file-directory-p (expand-file-name subdir dir)) ;; Check `package-load-list': (cond ((null force) @@ -410,28 +476,12 @@ the package by calling `package-load-descriptor'." (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." - (aref desc 0)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) + (package-load-descriptor name version dir)))) (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)) +NAME is the package name as a symbol and VERSION is a string." + (let* ((subdir (format "%s-%s" name version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -442,9 +492,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-version pkg-desc))) (pkg-dir (package--dir name version-str))) (unless pkg-dir (error "Internal error: unable to find directory for `%s-%s'" @@ -457,8 +507,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 (format "%s-autoloads" name) pkg-dir) nil t) + (push name package-activated-list) ;; Don't return nil. t)) @@ -471,98 +521,58 @@ specifying the minimum acceptable version." (version-list-<= min-version (version-to-list emacs-version)) (let ((elt (assq package package--builtins))) (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) + (package-desc-version (cdr elt))))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package min-version) - "Activate package PACKAGE, of version MIN-VERSION or newer. +(defun package-activate (name min-version) + "Activate package NAME, of version MIN-VERSION or newer. MIN-VERSION should be a version list. -If PACKAGE has any dependencies, recursively activate them. +If NAME 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 name 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-version pkg-desc) found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. ((null found) - (package-built-in-p package min-version)) + (package-built-in-p name min-version)) ;; If the package is already activated, just return t. - ((memq package package-activated-list) + ((memq name package-activated-list) t) ;; Otherwise, proceed with activation. (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 (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" - package (car fail) (package-version-join (cadr fail))) + name (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-version 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) - "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. -DOCSTRING is a short description of the package, a string. -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." - (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))) - (old-pkg (assq name package-alist))) - (cond - ;; If there's no old package, just add this to `package-alist'. - ((null old-pkg) - (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)) - (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 - ;; the system package directory and one in your private - ;; 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)))))) - ;; From Emacs 22. (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." @@ -584,13 +594,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")) + (let* ((auto-name (format "%s-autoloads.el" name)) (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-buffer auto-name)))) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) @@ -608,9 +618,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. +VERSION must be a string. NAME is the package name as a symbol." + (let* ((dirname (format "%s-%s" 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? @@ -620,30 +631,33 @@ untar into a directory named DIR; otherwise, signal an error." (defun package--make-autoloads-and-compile (name pkg-dir) "Generate autoloads and do byte-compilation for package named NAME. -PKG-DIR is the name of the package directory." +NAME is the name of the file to compile as a symbol and PKG-DIR +is the name of the package directory." (package-generate-autoloads name pkg-dir) (let ((load-path (cons pkg-dir load-path))) ;; We must load the autoloads file before byte compiling, in ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) (byte-recompile-directory pkg-dir 0 t))) (defun package--write-file-no-coding (file-name) (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 is the name of the package as a symbol; VERSION and DESC +must be strings." ;; Special case "package". - (if (string= file-name "package") + (if (eq 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 "-" + (expand-file-name (format "%s.el" name) package-user-dir)) + (let* ((pkg-dir (expand-file-name (format "%s-%s" name (package-version-join (version-to-list 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))) + package-user-dir)) + (el-file (expand-file-name (format "%s.el" name) pkg-dir)) + (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) (make-directory pkg-dir t) (package--write-file-no-coding el-file) (let ((print-level nil) @@ -652,21 +666,20 @@ PKG-DIR is the name of the package directory." (concat (prin1-to-string (list 'define-package - file-name + (symbol-name name) version desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) + ;; 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. @@ -714,26 +727,26 @@ It will move point to somewhere in the headers." (defun package-download-single (name version desc requires) "Download and install a single-file package." (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".el"))) + (file (format "%s-%s.el" name version))) (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) + (package-unpack-single 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"))) + (file (format "%s-%s.tar" name version))) (package--with-work-buffer location file - (package-unpack name version)))) + (package-unpack name version)))) -(defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of MIN-VERSION or newer, is installed. -MIN-VERSION should be a version list." - (let ((pkg-desc (assq package package-alist))) +(defun package-installed-p (name &optional min-version) + "Return true if NAME, of MIN-VERSION or newer, is installed. +NAME must be a symbol and MIN-VERSION must be a version list." + (let ((pkg-desc (assq name package-alist))) (if pkg-desc (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. - (package-built-in-p package min-version)))) + (package-built-in-p name min-version)))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -754,7 +767,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)) @@ -774,18 +787,18 @@ but version %s required" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version 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))))) + (package-version-join (package-desc-version 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) @@ -828,8 +841,6 @@ If successful, set `package-archive-contents'." "Re-read archive contents for ARCHIVE. If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." - ;; Version 1 of 'archive-contents' is identical to our internal - ;; representation. (let* ((dir (concat "archives/" archive)) (contents-file (concat dir "/archive-contents")) contents) @@ -839,16 +850,24 @@ If the archive version is too new, signal an error." (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))) +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (pkg-desc + ;; These are the offsets into the "archive-contents" + ;; array. They are formatted this way for historical reasons + ;; which is why they are magic numbers here. + (package-desc-create :name name + :version (aref (cdr package) 0) + :reqs (aref (cdr package) 1) + :summary (aref (cdr package) 2) + :kind (aref (cdr package) 3) + :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) + ((version-list-< (package-desc-version (cdr existing-package)) + (package-desc-version pkg-desc)) ;; Replace the entry with this one. (setq package-archive-contents (cons entry @@ -867,21 +886,21 @@ using `package-compute-transaction'." ;; `package-load-list', download the held version. (hold (cadr (assq elt package-load-list))) (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) + (package-version-join (package-desc-version desc)))) (kind (package-desc-kind desc))) (cond ((eq kind 'tar) (package-download-tar elt v-string)) ((eq kind 'single) (package-download-single elt v-string - (package-desc-doc desc) + (package-desc-summary desc) (package-desc-reqs desc))) (t (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-maybe-load-descriptor elt v-string package-user-dir) (package-activate elt (version-to-list v-string))))) @@ -928,17 +947,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 @@ -947,9 +956,9 @@ boundaries." (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) (error "Packages lacks a file header")) (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) + (summary (match-string-no-properties 2)) (start (line-beginning-position))) - (unless (search-forward (concat ";;; " file-name ".el ends here")) + (unless (search-forward (format ";;; %s.el ends here" file-name)) (error "Package lacks a terminating comment")) ;; Try to include a trailing newline. (forward-line) @@ -968,19 +977,17 @@ 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)))) + + (package-desc-create :name (intern file-name) + :version (version-to-list pkg-version) + :summary summary + :reqs requires + :kind 'single)))) (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'." + "Build a `package-desc' from the contents of a tar file. +Looks for a \"foo-pkg.el\" file in the tar file which must +contain a package definition." (let ((default-directory (file-name-directory file)) (file (file-name-nondirectory file))) (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") @@ -991,68 +998,52 @@ The return result is a vector like `package-buffer-info'." ;; Extract the package descriptor. (pkg-def-contents (shell-command-to-string ;; Requires GNU tar. - (concat "tar -xOf " file " " - - pkg-name "-" pkg-version "/" - pkg-name "-pkg.el"))) + (format "tar -xOf %s %s-%s/%s-pkg.el" + file pkg-name pkg-version pkg-name))) (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 ((pkg-desc (apply #'package-desc-from-define + (append (cdr pkg-def-parsed) '(:kind tar))))) + (unless (equal (package-version-join (package-desc-version 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) "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." + (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* ((name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (pkg-version (package-desc-version 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 name + (package-version-join pkg-version) + (package-desc-summary pkg-desc) + requires)) + ((eq kind 'tar) + (package-unpack 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 +1056,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) @@ -1083,9 +1074,10 @@ The file can either be a tar file or an Emacs Lisp file." name version)))) (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)))) + "Return the archive containing the package NAME. +NAME must be a symbol." + (let ((desc (cdr (assq name package-archive-contents)))) + (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. @@ -1130,7 +1122,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt) (package-desc-version (cdr elt))))) (setq package--initialized t)) \f @@ -1177,21 +1169,21 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (cond ;; Loaded packages are in `package-alist'. ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) + (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package--dir package-name version)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) + (setq version (package-version-join (package-desc-version desc)) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1240,7 +1232,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (dolist (req reqs) (setq name (car req) vers (cadr req) - text (format "%s-%s" (symbol-name name) + text (format "%s-%s" name (package-version-join vers))) (cond (first (setq first nil)) ((>= (+ 2 (current-column) (length text)) @@ -1250,11 +1242,11 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. - (let ((fn (locate-file (concat package-name ".el") load-path + (let ((fn (locate-file (format "%s.el" package-name) load-path load-file-rep-suffixes)) (opoint (point))) (insert (or (lm-commentary fn) "")) @@ -1264,14 +1256,14 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (replace-match "")) (while (re-search-forward "^\\(;+ ?\\)" nil t) (replace-match "")))) - (let ((readme (expand-file-name (concat package-name "-readme.txt") + (let ((readme (expand-file-name (format "%s-readme.txt" package-name) package-user-dir)) readme-string) ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. (cond ((condition-case nil (package--with-work-buffer (package-archive-base package) - (concat package-name "-readme.txt") + (format "%s-readme.txt" package-name) (setq buffer-file-name (expand-file-name readme package-user-dir)) (let ((version-control 'never)) @@ -1376,29 +1368,38 @@ 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. The values of LISTNAME are lists +of STATUS and the package summary. + +LISTNAME looks like this: + +\( ((foo . (1 2 3)) + (status summary)) ... )" + `(cl-pushnew (list (cons (package-desc-name ,pkg) + (package-desc-version ,pkg)) + ,status + (package-desc-summary ,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,14 +1409,14 @@ 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) + (package--push (cdr elt) (cond ((and hold (null (cadr hold))) "disabled") ((memq name package-menu--new-package-list) "new") @@ -1426,21 +1427,21 @@ or a list of package names (symbols) to display." (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 SUMMARY). +Return (KEY [NAME VERSION-STRING STATUS SUMMARY]), 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)) + (summary (or (nth 2 entry) "")) (face (cond ((string= status "built-in") 'font-lock-builtin-face) ((string= status "available") 'default) @@ -1449,16 +1450,16 @@ identifier (NAME . VERSION-LIST)." ((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) (propertize status 'font-lock-face face) - (propertize doc 'font-lock-face face))))) + (propertize summary 'font-lock-face face))))) (defun package-menu-refresh () "Download the Emacs Lisp package archive. @@ -1534,7 +1535,7 @@ 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 SUMMARY]) (let ((pkg (car entry)) (status (aref (cadr entry) 2))) (cond ((equal status "installed") @@ -1617,7 +1618,7 @@ packages marked for deletion are removed." (format "Delete these %d packages (%s)? " (length delete-list) (mapconcat (lambda (elt) - (concat (car elt) "-" (cdr elt))) + (format "%s-%s" (car elt) (cdr elt))) delete-list ", ")))) (dolist (elt delete-list) @@ -1702,15 +1703,16 @@ The list is displayed in a buffer named `*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)) + (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")))))) + (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")))) + buf))) ;;;###autoload (defalias 'package-list-packages 'list-packages) diff --git a/lisp/finder.el b/lisp/finder.el index 6ccb4bf..5010c8b 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -205,12 +205,16 @@ from; the default is `load-path'." (setq version (ignore-errors (version-to-list version))) (setq entry (assq package package--builtins)) (cond ((null entry) - (push (cons package (vector version nil summary)) + (push (cons package (make-package-desc + :name package + :version version + :summary summary + :kind 'builtin)) package--builtins)) ((eq base-name package) (setq desc (cdr entry)) - (aset desc 0 version) - (aset desc 2 summary))) + (setf (package-desc-version desc) version + (package-desc-summary desc) summary))) (dolist (kw keywords) (puthash kw (cons package diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index 5f92e21..a6323df 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in @@ -50,7 +50,7 @@ emacs = EMACSLOADPATH=$(lispsrc):$(test) LC_ALL=C $(EMACS) $(EMACSOPT) # Common command to find subdirectories setwins=subdirs=`find . -type d -print`; \ for file in $$subdirs; do \ - case $$file in */.* | */.*/* | */=* ) ;; \ + case $$file in */.* | */.*/* | */=* | ./data* ) ;; \ *) wins="$$wins $$file" ;; \ esac; \ done diff --git a/test/automated/data/package/archive-contents b/test/automated/data/package/archive-contents new file mode 100644 index 0000000..64826ea --- /dev/null +++ b/test/automated/data/package/archive-contents @@ -0,0 +1,7 @@ +(1 + (simple-single . + [(1 3) + nil "A single-file package with no dependencies" single]) + (multi-file . + [(0 2 3) + nil "Example of a multi-file tar package" tar])) diff --git a/test/automated/data/package/multi-file-0.2.3/README b/test/automated/data/package/multi-file-0.2.3/README new file mode 100644 index 0000000..affd2e9 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/README @@ -0,0 +1 @@ +This is a bare-bones readme file for the multi-file package. diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el b/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el new file mode 100644 index 0000000..64bf756 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el @@ -0,0 +1 @@ +(define-package "multi-file" "0.2.3" "Example of a multi-file tar package" nil) diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el b/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el new file mode 100644 index 0000000..e14a6a9 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el @@ -0,0 +1,39 @@ +;;; multi-file-sub.el --- A dependent file within a package. + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Jane Smith <jsmith@example.com> +;; Keywords: lisp, tools +;; Package: multi-file +;; Version: 0.2.3 + +;; This file is part of GNU Emacs. + +;; 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. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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/>. + +;;; Commentary: + +;; The main multi-file elisp source depends on this. + +;;; Code: + +(defun multi-file-frobnicate (count) + "Frobnicate the current buffer COUNT times." + (interactive "p") + (dotimes (frobs count) + (insert "frobnicated " frobs "!\n"))) + +(provide 'multi-file-sub) + +;;; multi-file-sub.el ends here diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file.el b/test/automated/data/package/multi-file-0.2.3/multi-file.el new file mode 100644 index 0000000..5fed7d8 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file.el @@ -0,0 +1,66 @@ +;;; multi-file.el --- Example of a multi-file tar package + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Jane Smith <jsmith@example.com> +;; Keywords: lisp, tools +;; Package: multi-file +;; Version: 0.2.3 + +;; This file is part of GNU Emacs. + +;; 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. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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/>. + +;;; Commentary: + +;; This is the main file of the "multi-file" package. + +;;; Code: + +(require 'multi-file-sub) + +(defgroup multi-file nil + "Multi-file example" + :group 'development) + +;;;###autoload +(defcustom multi-file-custom-var nil + "An example autoloaded custom variable" + :type 'boolean + :group 'multi-file) + +(defvar multi-file-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-l") 'multi-file-frobnicate) + map) + "Keymap for `multi-file-mode'") + + + +;;;###autoload +(define-derived-mode multi-file-mode text-mode "Multi" + "Major mode which does nothing but test things. + +The keys are: +\\{multi-file-mode-map}" + :group 'multi-file + (turn-off-auto-fill) + (set (make-local-variable 'comment-start) ";") + (setq case-fold-search nil)) + +(add-to-list 'auto-mode-alist '("\\.multi\\'" . multi-file-mode)) + +(provide 'multi-file) + +;;; multi-file.el ends here diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file.texi b/test/automated/data/package/multi-file-0.2.3/multi-file.texi new file mode 100644 index 0000000..be7568b --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file.texi @@ -0,0 +1,68 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename multi-file.info +@settitle Multi-file Example Manual 0.2.3 +@c %**end of header + +@copying +This is a short example of a complete Texinfo file. + +Copyright @copyright{} 2012 Jane Smith +@end copying + +@dircategory Emacs +@direntry +* Multi-file: (multi-file). Example of a multi-file tar package +@end direntry + +@titlepage +@title Multi-file Example Manual +@subtitle Example of a multi-file tar package +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@c Output the table of the contents at the beginning. +@contents + +@ifnottex +@node Top +@top Multi-file + +@insertcopying +@end ifnottex + +@menu +* First Chapter:: The first chapter is the only chapter in this sample. +* Index:: Complete index. +@end menu + + +@node First Chapter +@chapter First Chapter + +@cindex chapter, first + +This is the first chapter. +@cindex index entry, another + +Here is a numbered list. + +@enumerate +@item +This is the first item. + +@item +This is the second item. +@end enumerate + + +@node Index +@unnumbered Index + +@printindex cp + +@bye + +@c multi-file.texi ends here diff --git a/test/automated/data/package/simple-single-1.3.el b/test/automated/data/package/simple-single-1.3.el new file mode 100644 index 0000000..a617841 --- /dev/null +++ b/test/automated/data/package/simple-single-1.3.el @@ -0,0 +1,32 @@ +;;; simple-single.el --- A single-file package with no dependencies + +;; Author: J. R. Hacker <jrh@example.com> +;; Version: 1.3 +;; Keywords: frobnicate + +;;; Commentary: + +;; This package provides a minor mode to frobnicate and/or bifurcate +;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly" +;; and all your dreams will come true. + +;;; Code: + +(defgroup simple-single nil "Simply a file" + :group 'lisp) + +(defcustom simple-single-super-sunday t + "How great is this?" + :type 'boolean + :group 'simple-single) + +(defvar simple-single-sudo-sandwich nil + "Make a sandwich?") + +;;;###autoload +(define-minor-mode simple-single-mode + "It does good things to stuff") + +(provide 'simple-single) + +;;; simple-single.el ends here diff --git a/test/automated/package-test.el b/test/automated/package-test.el new file mode 100644 index 0000000..85edbe8 --- /dev/null +++ b/test/automated/package-test.el @@ -0,0 +1,261 @@ +;;; package-test.el --- Tests for the Emacs package system + +;; Author: Daniel Hackney <dan@haxney.org> +;; Version: 1.0 + +;; This file is part of GNU Emacs. + +;; 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, 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 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; 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: + +;; Run this from a separate Emacs instance from your main one as it +;; messes with the installed packages. In fact, you should probably +;; back up your `package-user-dir' just in case! + +;; Run this in a clean Emacs session using: +;; +;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'package) +(require 'ert) +(require 'cl-lib) + +(defvar package-test-original-user-dir package-user-dir + "Save the old value of `package-user-dir' to be restored later.") + +(defvar package-test-user-dir (make-temp-name + (concat temporary-file-directory "pkg-test-user-dir-")) + "Directory to use for installing packages during testing.") + +(setq package-user-dir package-test-user-dir) + +(defvar simple-single-desc [cl-struct-package-desc simple-single (1 3) + "A single-file package with no dependencies" + nil single nil] + "Expected `package-desc' parsed from simple-single-1.3.el.") + +(defvar package-test-dir (expand-file-name "data/package" (file-name-directory load-file-name)) + "Base directory of package test files.") + +(defvar package-test-fake-contents-file + (expand-file-name "archive-contents" package-test-dir) + "Path to a static copy of \"archive-contents\".") + +(defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info") + "Remove these files when cleaning up a built package.") + +(cl-defmacro with-package-test ((&optional &key file basedir build-dir install) &rest body) + "Set up temporary locations and variables for testing." + (declare (indent 1)) + `(let ((package-user-dir package-test-user-dir) + (package-archives `(("gnu" . ,package-test-dir))) + (old-yes-no-defn (symbol-function 'yes-or-no-p)) + ,@(if build-dir (list (list 'build-dir build-dir) + (list 'build-tar (concat build-dir ".tar"))) + (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `nil' + (unwind-protect + (progn + ,(if basedir (list 'cd basedir)) + (setf (symbol-function 'yes-or-no-p) #'ignore) + (unless (file-directory-p package-user-dir) + (mkdir package-user-dir)) + (if (boundp 'build-dir) + (package-test-build-multifile build-dir)) + ,@(when install + (list + (list 'package-refresh-contents) + ;; The two quotes before `package-install' are required! One is + ;; consumed by the macro expansion and the other prevents trying to + ;; take the `symbol-value' of `package-install' + (list 'mapc ''package-install install))) + (with-temp-buffer + ,(if file + (list 'insert-file-contents file)) + ,@body)) + ,(if build-dir + (list 'package-test-cleanup-built-files build-dir)) + (when (file-directory-p package-test-user-dir) + (delete-directory package-test-user-dir t)) + (setf (symbol-function 'yes-or-no-p) old-yes-no-defn)))) + +(defun package-test-install-texinfo (file) + "Install from texinfo FILE. + +FILE should be a .texinfo file relative to the current +`default-directory'" + (require 'info) + (let* ((full-file (expand-file-name file)) + (info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file)) + (old-info-defn (symbol-function 'Info-revert-find-node))) + (require 'info) + (setf (symbol-function 'Info-revert-find-node) #'ignore) + (with-current-buffer (find-file-literally full-file) + (unwind-protect + (progn + (require 'makeinfo) + (makeinfo-buffer) + ;; Give `makeinfo-buffer' a chance to finish + (while compilation-in-progress + (sit-for 0.1)) + (call-process "ginstall-info" nil nil nil + (format "--info-dir=%s" default-directory) + (format "%s" info-file))) + (kill-buffer) + (setf (symbol-function 'Info-revert-find-node) old-info-defn))))) + +(defun package-test-build-multifile (dir) + "Build a tar package from a multiple-file directory DIR. + +DIR must not have a trailing slash." + (let* ((pkg-dirname (file-name-nondirectory dir)) + (pkg-name (package-strip-version pkg-dirname)) + (pkg-version (match-string-no-properties 2 pkg-dirname)) + (tar-name (concat pkg-dirname ".tar")) + (default-directory (expand-file-name dir))) + (package-test-install-texinfo (concat pkg-name ".texi")) + (setq default-directory (file-name-directory default-directory)) + (call-process "tar" nil nil nil "-caf" tar-name pkg-dirname))) + +(defun package-test-suffix-matches (base suffix-list) + "Return file names matching BASE concatenated with each item in SUFFIX-LIST" + (cl-mapcan + '(lambda (item) (file-expand-wildcards (concat base item))) + suffix-list)) + +(defun package-test-cleanup-built-files (dir) + "Remove files which were the result of creating a tar archive. + +DIR is the base name of the package directory, without the trailing slash" + (let* ((pkg-dirname (file-name-nondirectory dir))) + (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes)) + (delete-file file)))) + +(defun package-test-search-tar-file (filename) + "Search the current buffer's `tar-parse-info' variable for FILENAME. + +Must called from within a `tar-mode' buffer." + (cl-dolist (header tar-parse-info) + (let ((tar-name (tar-header-name header))) + (when (string= tar-name filename) + (cl-return t))))) + +(ert-deftest package-test-buffer-info () + "Parse an elisp buffer to get a `package-desc' object." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (should (equal (package-buffer-info) simple-single-desc)))) + +(ert-deftest package-test-install-single () + "Install a single file without using an archive." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el") + (should (package-install-from-buffer (package-buffer-info))) + (let* ((simple-pkg-dir (file-name-as-directory + (expand-file-name + "simple-single-1.3" + package-test-user-dir))) + (autoloads-file (expand-file-name "simple-single-autoloads.el" simple-pkg-dir))) + (should (file-directory-p simple-pkg-dir)) + (with-temp-buffer + (insert-file-contents (expand-file-name "simple-single-pkg.el" simple-pkg-dir)) + (should (string= (buffer-string) + "(define-package \"simple-single\" \"1.3\" \"A single-file package with no dependencies\" nil)\n"))) + (should (file-exists-p autoloads-file)) + (should-not (get-file-buffer autoloads-file))))) + +(ert-deftest package-test-refresh-contents () + "Parse an \"archive-contents\" file." + (with-package-test () + (package-refresh-contents))) + +(ert-deftest package-test-install-single-from-archive () + "Install a single package from a package archive." + (with-package-test () + (package-refresh-contents) + (package-install 'simple-single))) + +(ert-deftest package-test-build-multifile () + "Build a multi-file archive." + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2.3") + (should (file-exists-p build-tar)) + (let ((suffixes + (remove build-tar (package-test-suffix-matches + build-dir + package-test-built-file-suffixes)))) + (with-current-buffer (find-file build-tar) + (dolist (file suffixes) + (should (package-test-search-tar-file file))) + (kill-buffer))))) + +(ert-deftest package-test-install-multifile () + "Check properties of the installed multi-file package." + (let ((autoload-file + (expand-file-name "multi-file-autoloads.el" + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir))) + (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" + "multi-file-autoloads.el" "multi-file.elc")) + (autoload-forms '("^(defvar multi-file-custom-var" + "^(custom-autoload 'multi-file-custom-var" + "^(autoload 'multi-file-mode" + "^(provide 'multi-file-autoloads)")) + (pkg-dir (file-name-as-directory + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir)))) + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2.3" + :install '(multi-file) + :file autoload-file) + (should (package-installed-p 'multi-file)) + (dolist (fn installed-files) + (should (file-exists-p (expand-file-name fn pkg-dir)))) + (dolist (re autoload-forms) + (goto-char (point-min)) + (should (re-search-forward re nil t)))))) + +(ert-deftest package-test-tar-desc () + "Examine the properties parsed from a tar package" + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2.3") + (let ((info (package-tar-file-info (expand-file-name build-tar)))) + (should (eq (package-desc-name info) 'multi-file)) + (should (equal (package-desc-version info) '(0 2 3))) + (should (equal (package-desc-summary info) "Example of a multi-file tar package")) + (should (equal (package-desc-reqs info) nil)) + (should (equal (package-desc-kind info) 'tar)) + ;; (should (equal (package-desc-commentary info) "This is a bare-bones readme file for the multi-file package.\n")) + ))) + +(ert-deftest package-test-update-listing () + "Ensure installed package status is updated." + (with-package-test + () + (let ((buf (package-list-packages))) + (search-forward-regexp "^ +simple-single") + (package-menu-mark-install) + (package-menu-execute) + (should (package-installed-p 'simple-single)) + (switch-to-buffer "*Packages*") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+available" nil t)) + (kill-buffer buf)))) + +(provide 'package-test) + +;;; package-test.el ends here ^ permalink raw reply related [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 1:11 ` Daniel Hackney @ 2012-10-09 6:48 ` Stefan Monnier 2012-10-09 17:07 ` Daniel Hackney 0 siblings, 1 reply; 20+ messages in thread From: Stefan Monnier @ 2012-10-09 6:48 UTC (permalink / raw) To: Daniel Hackney; +Cc: Chong Yidong, emacs-devel Hi Daniel, I think the patch is looking good, but it's a fairly significant change to install in the feature-frozen code, so I'd rather keep it for after 24.3 (the trunk should re-open for non-bugfix changes in November, so it's not a terribly long wait). Are there particular reasons why you think it would be important to install your changes for 24.3? Stefan ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 6:48 ` Stefan Monnier @ 2012-10-09 17:07 ` Daniel Hackney 2012-10-09 17:39 ` Stefan Monnier 0 siblings, 1 reply; 20+ messages in thread From: Daniel Hackney @ 2012-10-09 17:07 UTC (permalink / raw) To: Stefan Monnier; +Cc: Chong Yidong, emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> wrote: > Are there particular reasons why you think it would be important to > install your changes for 24.3? It certainly isn't pressing, but it would make future development (bugfixing, etc) easier. Pedantically speaking, however, my patch doesn't change any user-facing features. There are some potential bugs, such as deleting obsolete packages correctly, which I think could reasonably be considered "bug fixes" rather than "features" and correcting those would be much easier using my `defstruct'd code (and the associated test cases). Updating packages cleanly is currently bugged; Emacs still expects the docstrings to be at the old location, but if it is deleted (which is what `package-menu-mark-upgrades' offers to do), you will get "could not find docstring" errors which break certain commands. The fix is non-trivial (it involves messing with `load-history') and my changes will simplify that process. -- Daniel Hackney ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 17:07 ` Daniel Hackney @ 2012-10-09 17:39 ` Stefan Monnier 2012-10-09 21:39 ` Daniel Hackney 0 siblings, 1 reply; 20+ messages in thread From: Stefan Monnier @ 2012-10-09 17:39 UTC (permalink / raw) To: Daniel Hackney; +Cc: Chong Yidong, emacs-devel > the associated test cases). Updating packages cleanly is currently > bugged; Emacs still expects the docstrings to be at the old location, > but if it is deleted (which is what `package-menu-mark-upgrades' offers > to do), you will get "could not find docstring" errors which break > certain commands. The general rule is that failure to find the docstring should not break commands. I've fixed a few such cases recently, but if you find more, please report them. Even without package.el the file might disappear or be replaced and that's usually no justification to break the whole command (e.g. describe-function/variable is still useful even if the docstring is not found). Stefan ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 17:39 ` Stefan Monnier @ 2012-10-09 21:39 ` Daniel Hackney 2012-10-09 22:25 ` Glenn Morris 2012-10-12 3:58 ` Chong Yidong 0 siblings, 2 replies; 20+ messages in thread From: Daniel Hackney @ 2012-10-09 21:39 UTC (permalink / raw) To: Stefan Monnier; +Cc: Chong Yidong, emacs-devel Stefan Monnier <monnier@iro.umontreal.ca> wrote: >> the associated test cases). Updating packages cleanly is currently >> bugged; Emacs still expects the docstrings to be at the old location, >> but if it is deleted (which is what `package-menu-mark-upgrades' offers >> to do), you will get "could not find docstring" errors which break >> certain commands. > > The general rule is that failure to find the docstring should not > break commands. I've fixed a few such cases recently, but if you find > more, please report them. Even without package.el the file might > disappear or be replaced and that's usually no justification to break the > whole command (e.g. describe-function/variable is still useful even if the > docstring is not found). The only case in which I have experienced problems from an updated package is with the package "helm" which is not in the Emacs core. I could try to track down the problem and solve it within the helm library. I'll report back here if I find anything which looks like a core Emacs bug. I also remember having some trouble with installing or resuming an aborted install and getting "file exists" errors. I'd have to dig a little to remember what exactly was happening; if I find anything I'll start a new thread about it. But the main point is: I think we would be well-served by pulling these changes into 24.3 because it does not affect the user interface at all and is therefore not going against the idea of a feature freeze, cleans up the namespace by removing `define-package', and will make debugging package.el for the release of 24.3 easier by using consistent variable names and types throughout the library. -- Daniel Hackney ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 21:39 ` Daniel Hackney @ 2012-10-09 22:25 ` Glenn Morris 2012-10-12 3:58 ` Chong Yidong 1 sibling, 0 replies; 20+ messages in thread From: Glenn Morris @ 2012-10-09 22:25 UTC (permalink / raw) To: Daniel Hackney; +Cc: Chong Yidong, Stefan Monnier, emacs-devel Daniel Hackney wrote: > The only case in which I have experienced problems from an updated > package is with the package "helm" which is not in the Emacs core. I > could try to track down the problem and solve it within the helm > library. I'll report back here if I find anything which looks like a > core Emacs bug. You could followup to the existing report http://debbugs.gnu.org/cgi/bugreport.cgi?bug=12545 ^ permalink raw reply [flat|nested] 20+ messages in thread
* Re: [PATCH] Re: package.el changes before the feature freeze 2012-10-09 21:39 ` Daniel Hackney 2012-10-09 22:25 ` Glenn Morris @ 2012-10-12 3:58 ` Chong Yidong 1 sibling, 0 replies; 20+ messages in thread From: Chong Yidong @ 2012-10-12 3:58 UTC (permalink / raw) To: Daniel Hackney; +Cc: Stefan Monnier, emacs-devel Daniel Hackney <dan@haxney.org> writes: > But the main point is: I think we would be well-served by pulling > these changes into 24.3 because it does not affect the user interface > at all and is therefore not going against the idea of a feature freeze My major concern is that third party packages which use existing functions in package.el, whose calling conventions are changed by this patch, would experience incompatibilities. This is not a show stopper for the post-24.3 development tree, since we will have lots of time to find out what compatibility problems exist and adapt accordingly. But I don't think it's suitable for 24.3; I don't want 24.3's freeze to drag on for too long. > I also remember having some trouble with installing or resuming an > aborted install and getting "file exists" errors. I'd have to dig a > little to remember what exactly was happening; if I find anything I'll > start a new thread about it. Any such bugs would be orthogonal to the defstruct cleanup, and should be reported and addressed separately. ^ permalink raw reply [flat|nested] 20+ messages in thread
end of thread, other threads:[~2012-10-12 3:58 UTC | newest] Thread overview: 20+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2012-09-30 16:58 package.el changes before the feature freeze Daniel Hackney 2012-09-30 20:21 ` Stefan Monnier 2012-09-30 23:50 ` Daniel Hackney 2012-10-01 1:21 ` Stefan Monnier 2012-10-01 3:11 ` Chong Yidong 2012-10-03 0:33 ` Daniel Hackney 2012-10-03 22:41 ` [PATCH] " Daniel Hackney 2012-10-04 8:16 ` Chong Yidong 2012-10-05 23:13 ` Daniel Hackney 2012-10-06 1:38 ` Stefan Monnier 2012-10-08 2:32 ` Chong Yidong 2012-10-08 19:16 ` Daniel Hackney 2012-10-08 19:50 ` Stefan Monnier 2012-10-09 1:11 ` Daniel Hackney 2012-10-09 6:48 ` Stefan Monnier 2012-10-09 17:07 ` Daniel Hackney 2012-10-09 17:39 ` Stefan Monnier 2012-10-09 21:39 ` Daniel Hackney 2012-10-09 22:25 ` Glenn Morris 2012-10-12 3:58 ` Chong Yidong
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.