aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/ChangeLog30
-rw-r--r--lisp/emacs-lisp/package-x.el63
-rw-r--r--lisp/emacs-lisp/package.el378
-rw-r--r--lisp/finder.el3
4 files changed, 266 insertions, 208 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 10d706ad81c..ff4c2fb4444 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,33 @@
12013-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
2 Daniel Hackney <dan@haxney.org>
3
4 First part of Daniel Hackney's patch to package.el.
5 * emacs-lisp/package.el: Use defstruct.
6 (package-desc): New, main struct.
7 (package--bi-desc, package--ac-desc): New structs, used to describe the
8 format in external files.
9 (package-desc-vers): Replace with package-desc-version accessor.
10 (package-desc-doc): Replace with package-desc-summary accessor.
11 (package-activate-1): Remove `package' arg since the pkg-vec now
12 includes the name.
13 (define-package): Use package-desc-from-define.
14 (package-unpack-single): Change file-name arg to be a symbol.
15 (package--add-to-archive-contents): Use package-desc-create and new
16 accessor functions to package--ac-desc.
17 (package-buffer-info, package-tar-file-info): Return a package-desc.
18 (package-install-from-buffer): Remove `type' argument. Change pkg-info
19 arg to be a package-desc.
20 (package-install-file): Adjust accordingly. Use \' to match EOS.
21 (package--from-builtin): New function.
22 (describe-package-1, package-menu--generate): Use it.
23 (package--make-autoloads-and-compile): Change name arg to be a symbol.
24 (package-generate-autoloads): Idem and return the name of the file.
25 * emacs-lisp/package-x.el (package-upload-buffer-internal):
26 Change pkg-info arg to be a package-desc.
27 Use package-make-ac-desc.
28 (package-upload-file): Use \' to match EOS.
29 * finder.el (finder-compile-keywords): Use package-make-builtin.
30
12013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> 312013-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
2 32
3 * vc/vc.el (vc-deduce-fileset): Change error message. 33 * vc/vc.el (vc-deduce-fileset): Change error message.
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index a3ce1672a63..17919d9bbeb 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -162,9 +162,11 @@ DESCRIPTION is the text of the news item."
162 description 162 description
163 archive-url)) 163 archive-url))
164 164
165(defun package-upload-buffer-internal (pkg-info extension &optional archive-url) 165(declare-function lm-commentary "lisp-mnt" (&optional file))
166
167(defun package-upload-buffer-internal (pkg-desc extension &optional archive-url)
166 "Upload a package whose contents are in the current buffer. 168 "Upload a package whose contents are in the current buffer.
167PKG-INFO is the package info, see `package-buffer-info'. 169PKG-DESC is the `package-desc'.
168EXTENSION is the file extension, a string. It can be either 170EXTENSION is the file extension, a string. It can be either
169\"el\" or \"tar\". 171\"el\" or \"tar\".
170 172
@@ -196,18 +198,18 @@ if it exists."
196 (error "Aborted"))) 198 (error "Aborted")))
197 (save-excursion 199 (save-excursion
198 (save-restriction 200 (save-restriction
199 (let* ((file-type (cond 201 (let* ((file-type (package-desc-kind pkg-desc))
200 ((equal extension "el") 'single) 202 (pkg-name (package-desc-name pkg-desc))
201 ((equal extension "tar") 'tar) 203 (requires (package-desc-reqs pkg-desc))
202 (t (error "Unknown extension `%s'" extension)))) 204 (desc (if (eq (package-desc-summary pkg-desc)
203 (file-name (aref pkg-info 0)) 205 package--default-summary)
204 (pkg-name (intern file-name))
205 (requires (aref pkg-info 1))
206 (desc (if (string= (aref pkg-info 2) "")
207 (read-string "Description of package: ") 206 (read-string "Description of package: ")
208 (aref pkg-info 2))) 207 (package-desc-summary pkg-desc)))
209 (pkg-version (aref pkg-info 3)) 208 (pkg-version (package-desc-version pkg-desc))
210 (commentary (aref pkg-info 4)) 209 (commentary
210 (pcase file-type
211 (`single (lm-commentary))
212 (`tar nil))) ;; FIXME: Get it from the README file.
211 (split-version (version-to-list pkg-version)) 213 (split-version (version-to-list pkg-version))
212 (pkg-buffer (current-buffer))) 214 (pkg-buffer (current-buffer)))
213 215
@@ -215,7 +217,8 @@ if it exists."
215 ;; from `package-archive-upload-base' otherwise. 217 ;; from `package-archive-upload-base' otherwise.
216 (let ((contents (or (package--archive-contents-from-url archive-url) 218 (let ((contents (or (package--archive-contents-from-url archive-url)
217 (package--archive-contents-from-file))) 219 (package--archive-contents-from-file)))
218 (new-desc (vector split-version requires desc file-type))) 220 (new-desc (package-make-ac-desc
221 split-version requires desc file-type)))
219 (if (> (car contents) package-archive-version) 222 (if (> (car contents) package-archive-version)
220 (error "Unrecognized archive version %d" (car contents))) 223 (error "Unrecognized archive version %d" (car contents)))
221 (let ((elt (assq pkg-name (cdr contents)))) 224 (let ((elt (assq pkg-name (cdr contents))))
@@ -232,6 +235,7 @@ if it exists."
232 ;; this and the package itself. For now we assume ELPA is 235 ;; this and the package itself. For now we assume ELPA is
233 ;; writable via file primitives. 236 ;; writable via file primitives.
234 (let ((print-level nil) 237 (let ((print-level nil)
238 (print-quoted t)
235 (print-length nil)) 239 (print-length nil))
236 (write-region (concat (pp-to-string contents) "\n") 240 (write-region (concat (pp-to-string contents) "\n")
237 nil 241 nil
@@ -241,29 +245,29 @@ if it exists."
241 ;; If there is a commentary section, write it. 245 ;; If there is a commentary section, write it.
242 (when commentary 246 (when commentary
243 (write-region commentary nil 247 (write-region commentary nil
244 (expand-file-name 248 (expand-file-name
245 (concat (symbol-name pkg-name) "-readme.txt") 249 (concat (symbol-name pkg-name) "-readme.txt")
246 package-archive-upload-base))) 250 package-archive-upload-base)))
247 251
248 (set-buffer pkg-buffer) 252 (set-buffer pkg-buffer)
249 (write-region (point-min) (point-max) 253 (write-region (point-min) (point-max)
250 (expand-file-name 254 (expand-file-name
251 (concat file-name "-" pkg-version "." extension) 255 (format "%s-%s.%s" pkg-name pkg-version extension)
252 package-archive-upload-base) 256 package-archive-upload-base)
253 nil nil nil 'excl) 257 nil nil nil 'excl)
254 258
255 ;; Write a news entry. 259 ;; Write a news entry.
256 (and package-update-news-on-upload 260 (and package-update-news-on-upload
257 archive-url 261 archive-url
258 (package--update-news (concat file-name "." extension) 262 (package--update-news (format "%s.%s" pkg-name extension)
259 pkg-version desc archive-url)) 263 pkg-version desc archive-url))
260 264
261 ;; special-case "package": write a second copy so that the 265 ;; special-case "package": write a second copy so that the
262 ;; installer can easily find the latest version. 266 ;; installer can easily find the latest version.
263 (if (string= file-name "package") 267 (if (eq pkg-name 'package)
264 (write-region (point-min) (point-max) 268 (write-region (point-min) (point-max)
265 (expand-file-name 269 (expand-file-name
266 (concat file-name "." extension) 270 (format "%s.%s" pkg-name extension)
267 package-archive-upload-base) 271 package-archive-upload-base)
268 nil nil nil 'ask)))))))) 272 nil nil nil 'ask))))))))
269 273
@@ -275,8 +279,8 @@ destination, prompt for one."
275 (save-excursion 279 (save-excursion
276 (save-restriction 280 (save-restriction
277 ;; Find the package in this buffer. 281 ;; Find the package in this buffer.
278 (let ((pkg-info (package-buffer-info))) 282 (let ((pkg-desc (package-buffer-info)))
279 (package-upload-buffer-internal pkg-info "el"))))) 283 (package-upload-buffer-internal pkg-desc "el")))))
280 284
281(defun package-upload-file (file) 285(defun package-upload-file (file)
282 "Upload the Emacs Lisp package FILE to the package archive. 286 "Upload the Emacs Lisp package FILE to the package archive.
@@ -288,12 +292,13 @@ destination, prompt for one."
288 (interactive "fPackage file name: ") 292 (interactive "fPackage file name: ")
289 (with-temp-buffer 293 (with-temp-buffer
290 (insert-file-contents-literally file) 294 (insert-file-contents-literally file)
291 (let ((info (cond 295 (let ((pkg-desc
292 ((string-match "\\.tar$" file) (package-tar-file-info file)) 296 (cond
293 ((string-match "\\.el$" file) (package-buffer-info)) 297 ((string-match "\\.tar\\'" file) (package-tar-file-info file))
294 (t (error "Unrecognized extension `%s'" 298 ((string-match "\\.el\\'" file) (package-buffer-info))
295 (file-name-extension file)))))) 299 (t (error "Unrecognized extension `%s'"
296 (package-upload-buffer-internal info (file-name-extension file))))) 300 (file-name-extension file))))))
301 (package-upload-buffer-internal pkg-desc (file-name-extension file)))))
297 302
298(defun package-gnus-summary-upload () 303(defun package-gnus-summary-upload ()
299 "Upload a package contained in the current *Article* buffer. 304 "Upload a package contained in the current *Article* buffer.
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 41b635bbe30..d5176abded0 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -170,6 +170,8 @@
170 170
171;;; Code: 171;;; Code:
172 172
173(eval-when-compile (require 'cl-lib))
174
173(require 'tabulated-list) 175(require 'tabulated-list)
174 176
175(defgroup package nil 177(defgroup package nil
@@ -262,11 +264,8 @@ Lower version numbers than this will probably be understood as well.")
262;; We don't prime the cache since it tends to get out of date. 264;; We don't prime the cache since it tends to get out of date.
263(defvar package-archive-contents nil 265(defvar package-archive-contents nil
264 "Cache of the contents of the Emacs Lisp Package Archive. 266 "Cache of the contents of the Emacs Lisp Package Archive.
265This is an alist mapping package names (symbols) to package 267This is an alist mapping package names (symbols) to
266descriptor vectors. These are like the vectors for `package-alist' 268`package--desc' structures.")
267but have extra entries: one which is 'tar for tar packages and
268'single for single-file packages, and one which is the name of
269the archive from which it came.")
270(put 'package-archive-contents 'risky-local-variable t) 269(put 'package-archive-contents 'risky-local-variable t)
271 270
272(defcustom package-user-dir (locate-user-emacs-file "elpa") 271(defcustom package-user-dir (locate-user-emacs-file "elpa")
@@ -297,6 +296,62 @@ contrast, `package-user-dir' contains packages for personal use."
297 :group 'package 296 :group 'package
298 :version "24.1") 297 :version "24.1")
299 298
299(defvar package--default-summary "No description available.")
300
301(cl-defstruct (package-desc
302 ;; Rename the default constructor from `make-package-desc'.
303 (:constructor package-desc-create)
304 ;; Has the same interface as the old `define-package',
305 ;; which is still used in the "foo-pkg.el" files. Extra
306 ;; options can be supported by adding additional keys.
307 (:constructor
308 package-desc-from-define
309 (name-string version-string &optional summary requirements
310 &key kind archive
311 &aux
312 (name (intern name-string))
313 (version (version-to-list version-string))
314 (reqs (mapcar #'(lambda (elt)
315 (list (car elt)
316 (version-to-list (cadr elt))))
317 (if (eq 'quote (car requirements))
318 (nth 1 requirements)
319 requirements))))))
320 "Structure containing information about an individual package.
321
322Slots:
323
324`name' Name of the package, as a symbol.
325
326`version' Version of the package, as a version list.
327
328`summary' Short description of the package, typically taken from
329the first line of the file.
330
331`reqs' Requirements of the package. A list of (PACKAGE
332VERSION-LIST) naming the dependent package and the minimum
333required version.
334
335`kind' The distribution format of the package. Currently, it is
336either `single' or `tar'.
337
338`archive' The name of the archive (as a string) whence this
339package came."
340 name
341 version
342 (summary package--default-summary)
343 reqs
344 kind
345 archive)
346
347;; Package descriptor format used in finder-inf.el and package--builtins.
348(cl-defstruct (package--bi-desc
349 (:constructor package-make-builtin (version summary))
350 (:type vector))
351 version
352 reqs
353 summary)
354
300;; The value is precomputed in finder-inf.el, but don't load that 355;; The value is precomputed in finder-inf.el, but don't load that
301;; until it's needed (i.e. when `package-initialize' is called). 356;; until it's needed (i.e. when `package-initialize' is called).
302(defvar package--builtins nil 357(defvar package--builtins nil
@@ -305,27 +360,14 @@ The actual value is initialized by loading the library
305`finder-inf'; this is not done until it is needed, e.g. by the 360`finder-inf'; this is not done until it is needed, e.g. by the
306function `package-built-in-p'. 361function `package-built-in-p'.
307 362
308Each element has the form (PKG . DESC), where PKG is a package 363Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package
309name (a symbol) and DESC is a vector that describes the package. 364name (a symbol) and DESC is a `package--bi-desc' structure.")
310The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
311 VERSION-LIST is a version list.
312 REQS is a list of packages required by the package, each
313 requirement having the form (NAME VL), where NAME is a string
314 and VL is a version list.
315 DOCSTRING is a brief description of the package.")
316(put 'package--builtins 'risky-local-variable t) 365(put 'package--builtins 'risky-local-variable t)
317 366
318(defvar package-alist nil 367(defvar package-alist nil
319 "Alist of all packages available for activation. 368 "Alist of all packages available for activation.
320Each element has the form (PKG . DESC), where PKG is a package 369Each element has the form (PKG . DESC), where PKG is a package
321name (a symbol) and DESC is a vector that describes the package. 370name (a symbol) and DESC is a `package-desc' structure.
322
323The vector DESC has the form [VERSION-LIST REQS DOCSTRING].
324 VERSION-LIST is a version list.
325 REQS is a list of packages required by the package, each
326 requirement having the form (NAME VL) where NAME is a string
327 and VL is a version list.
328 DOCSTRING is a brief description of the package.
329 371
330This variable is set automatically by `package-load-descriptor', 372This variable is set automatically by `package-load-descriptor',
331called via `package-initialize'. To change which packages are 373called via `package-initialize'. To change which packages are
@@ -339,7 +381,10 @@ loaded and/or activated, customize `package-load-list'.")
339(defvar package-obsolete-alist nil 381(defvar package-obsolete-alist nil
340 "Representation of obsolete packages. 382 "Representation of obsolete packages.
341Like `package-alist', but maps package name to a second alist. 383Like `package-alist', but maps package name to a second alist.
342The inner alist is keyed by version.") 384The inner alist is keyed by version.
385
386Each element of the list is (NAME . VERSION-ALIST), where each
387entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).")
343(put 'package-obsolete-alist 'risky-local-variable t) 388(put 'package-obsolete-alist 'risky-local-variable t)
344 389
345(defun package-version-join (vlist) 390(defun package-version-join (vlist)
@@ -430,26 +475,16 @@ the package by calling `package-load-descriptor'."
430 ;; Actually load the descriptor: 475 ;; Actually load the descriptor:
431 (package-load-descriptor dir subdir)))) 476 (package-load-descriptor dir subdir))))
432 477
433(defsubst package-desc-vers (desc) 478(define-obsolete-function-alias 'package-desc-vers 'package-desc-version "24.4")
434 "Extract version from a package description vector."
435 (aref desc 0))
436 479
437(defsubst package-desc-reqs (desc) 480(define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4")
438 "Extract requirements from a package description vector."
439 (aref desc 1))
440 481
441(defsubst package-desc-doc (desc)
442 "Extract doc string from a package description vector."
443 (aref desc 2))
444
445(defsubst package-desc-kind (desc)
446 "Extract the kind of download from an archive package description vector."
447 (aref desc 3))
448 482
449(defun package--dir (name version) 483(defun package--dir (name version)
484 ;; FIXME: Keep this as a field in the package-desc.
450 "Return the directory where a package is installed, or nil if none. 485 "Return the directory where a package is installed, or nil if none.
451NAME and VERSION are both strings." 486NAME is a symbol and VERSION is a string."
452 (let* ((subdir (concat name "-" version)) 487 (let* ((subdir (format "%s-%s" name version))
453 (dir-list (cons package-user-dir package-directory-list)) 488 (dir-list (cons package-user-dir package-directory-list))
454 pkg-dir) 489 pkg-dir)
455 (while dir-list 490 (while dir-list
@@ -460,9 +495,9 @@ NAME and VERSION are both strings."
460 (setq dir-list (cdr dir-list))))) 495 (setq dir-list (cdr dir-list)))))
461 pkg-dir)) 496 pkg-dir))
462 497
463(defun package-activate-1 (package pkg-vec) 498(defun package-activate-1 (pkg-desc)
464 (let* ((name (symbol-name package)) 499 (let* ((name (package-desc-name pkg-desc))
465 (version-str (package-version-join (package-desc-vers pkg-vec))) 500 (version-str (package-version-join (package-desc-version pkg-desc)))
466 (pkg-dir (package--dir name version-str))) 501 (pkg-dir (package--dir name version-str)))
467 (unless pkg-dir 502 (unless pkg-dir
468 (error "Internal error: unable to find directory for `%s-%s'" 503 (error "Internal error: unable to find directory for `%s-%s'"
@@ -475,8 +510,8 @@ NAME and VERSION are both strings."
475 (push pkg-dir Info-directory-list)) 510 (push pkg-dir Info-directory-list))
476 ;; Add to load path, add autoloads, and activate the package. 511 ;; Add to load path, add autoloads, and activate the package.
477 (push pkg-dir load-path) 512 (push pkg-dir load-path)
478 (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) 513 (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t)
479 (push package package-activated-list) 514 (push name package-activated-list)
480 ;; Don't return nil. 515 ;; Don't return nil.
481 t)) 516 t))
482 517
@@ -489,7 +524,12 @@ specifying the minimum acceptable version."
489 (version-list-<= min-version (version-to-list emacs-version)) 524 (version-list-<= min-version (version-to-list emacs-version))
490 (let ((elt (assq package package--builtins))) 525 (let ((elt (assq package package--builtins)))
491 (and elt (version-list-<= min-version 526 (and elt (version-list-<= min-version
492 (package-desc-vers (cdr elt))))))) 527 (package--bi-desc-version (cdr elt)))))))
528
529(defun package--from-builtin (bi-desc)
530 (package-desc-create :name (pop bi-desc)
531 :version (package--bi-desc-version bi-desc)
532 :summary (package--bi-desc-summary bi-desc)))
493 533
494;; This function goes ahead and activates a newer version of a package 534;; This function goes ahead and activates a newer version of a package
495;; if an older one was already activated. This is not ideal; we'd at 535;; if an older one was already activated. This is not ideal; we'd at
@@ -504,7 +544,7 @@ Return nil if the package could not be activated."
504 available-version found) 544 available-version found)
505 ;; Check if PACKAGE is available in `package-alist'. 545 ;; Check if PACKAGE is available in `package-alist'.
506 (when pkg-vec 546 (when pkg-vec
507 (setq available-version (package-desc-vers pkg-vec) 547 (setq available-version (package-desc-version pkg-vec)
508 found (version-list-<= min-version available-version))) 548 found (version-list-<= min-version available-version)))
509 (cond 549 (cond
510 ;; If no such package is found, maybe it's built-in. 550 ;; If no such package is found, maybe it's built-in.
@@ -525,7 +565,7 @@ Return nil if the package could not be activated."
525Required package `%s-%s' is unavailable" 565Required package `%s-%s' is unavailable"
526 package (car fail) (package-version-join (cadr fail))) 566 package (car fail) (package-version-join (cadr fail)))
527 ;; If all goes well, activate the package itself. 567 ;; If all goes well, activate the package itself.
528 (package-activate-1 package pkg-vec))))))) 568 (package-activate-1 pkg-vec)))))))
529 569
530(defun package-mark-obsolete (package pkg-vec) 570(defun package-mark-obsolete (package pkg-vec)
531 "Put package on the obsolete list, if not already there." 571 "Put package on the obsolete list, if not already there."
@@ -533,11 +573,11 @@ Required package `%s-%s' is unavailable"
533 (if elt 573 (if elt
534 ;; If this obsolete version does not exist in the list, update 574 ;; If this obsolete version does not exist in the list, update
535 ;; it the list. 575 ;; it the list.
536 (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) 576 (unless (assoc (package-desc-version pkg-vec) (cdr elt))
537 (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) 577 (setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec)
538 (cdr elt)))) 578 (cdr elt))))
539 ;; Make a new association. 579 ;; Make a new association.
540 (push (cons package (list (cons (package-desc-vers pkg-vec) 580 (push (cons package (list (cons (package-desc-version pkg-vec)
541 pkg-vec))) 581 pkg-vec)))
542 package-obsolete-alist)))) 582 package-obsolete-alist))))
543 583
@@ -555,21 +595,17 @@ REQUIREMENTS is a list of dependencies on other packages.
555EXTRA-PROPERTIES is currently unused." 595EXTRA-PROPERTIES is currently unused."
556 (let* ((name (intern name-string)) 596 (let* ((name (intern name-string))
557 (version (version-to-list version-string)) 597 (version (version-to-list version-string))
558 (new-pkg-desc 598 (new-pkg-desc (cons name
559 (cons name 599 (package-desc-from-define name-string
560 (vector version 600 version-string
561 (mapcar 601 docstring
562 (lambda (elt) 602 requirements)))
563 (list (car elt)
564 (version-to-list (car (cdr elt)))))
565 requirements)
566 docstring)))
567 (old-pkg (assq name package-alist))) 603 (old-pkg (assq name package-alist)))
568 (cond 604 (cond
569 ;; If there's no old package, just add this to `package-alist'. 605 ;; If there's no old package, just add this to `package-alist'.
570 ((null old-pkg) 606 ((null old-pkg)
571 (push new-pkg-desc package-alist)) 607 (push new-pkg-desc package-alist))
572 ((version-list-< (package-desc-vers (cdr old-pkg)) version) 608 ((version-list-< (package-desc-version (cdr old-pkg)) version)
573 ;; Remove the old package and declare it obsolete. 609 ;; Remove the old package and declare it obsolete.
574 (package-mark-obsolete name (cdr old-pkg)) 610 (package-mark-obsolete name (cdr old-pkg))
575 (setq package-alist (cons new-pkg-desc 611 (setq package-alist (cons new-pkg-desc
@@ -577,7 +613,7 @@ EXTRA-PROPERTIES is currently unused."
577 ;; You can have two packages with the same version, e.g. one in 613 ;; You can have two packages with the same version, e.g. one in
578 ;; the system package directory and one in your private 614 ;; the system package directory and one in your private
579 ;; directory. We just let the first one win. 615 ;; directory. We just let the first one win.
580 ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) 616 ((not (version-list-= (package-desc-version (cdr old-pkg)) version))
581 ;; The package is born obsolete. 617 ;; The package is born obsolete.
582 (package-mark-obsolete name (cdr new-pkg-desc)))))) 618 (package-mark-obsolete name (cdr new-pkg-desc))))))
583 619
@@ -603,14 +639,15 @@ EXTRA-PROPERTIES is currently unused."
603 639
604(defun package-generate-autoloads (name pkg-dir) 640(defun package-generate-autoloads (name pkg-dir)
605 (require 'autoload) ;Load before we let-bind generated-autoload-file! 641 (require 'autoload) ;Load before we let-bind generated-autoload-file!
606 (let* ((auto-name (concat name "-autoloads.el")) 642 (let* ((auto-name (format "%s-autoloads.el" name))
607 ;;(ignore-name (concat name "-pkg.el")) 643 ;;(ignore-name (concat name "-pkg.el"))
608 (generated-autoload-file (expand-file-name auto-name pkg-dir)) 644 (generated-autoload-file (expand-file-name auto-name pkg-dir))
609 (version-control 'never)) 645 (version-control 'never))
610 (package-autoload-ensure-default-file generated-autoload-file) 646 (package-autoload-ensure-default-file generated-autoload-file)
611 (update-directory-autoloads pkg-dir) 647 (update-directory-autoloads pkg-dir)
612 (let ((buf (find-buffer-visiting generated-autoload-file))) 648 (let ((buf (find-buffer-visiting generated-autoload-file)))
613 (when buf (kill-buffer buf))))) 649 (when buf (kill-buffer buf)))
650 auto-name))
614 651
615(defvar tar-parse-info) 652(defvar tar-parse-info)
616(declare-function tar-untar-buffer "tar-mode" ()) 653(declare-function tar-untar-buffer "tar-mode" ())
@@ -644,57 +681,62 @@ untar into a directory named DIR; otherwise, signal an error."
644 ;; FIXME: should we delete PKG-DIR if it exists? 681 ;; FIXME: should we delete PKG-DIR if it exists?
645 (let* ((default-directory (file-name-as-directory package-user-dir))) 682 (let* ((default-directory (file-name-as-directory package-user-dir)))
646 (package-untar-buffer dirname) 683 (package-untar-buffer dirname)
647 (package--make-autoloads-and-compile name pkg-dir)))) 684 (package--make-autoloads-and-compile package pkg-dir))))
648 685
649(defun package--make-autoloads-and-compile (name pkg-dir) 686(defun package--make-autoloads-and-compile (name pkg-dir)
650 "Generate autoloads and do byte-compilation for package named NAME. 687 "Generate autoloads and do byte-compilation for package named NAME.
651PKG-DIR is the name of the package directory." 688PKG-DIR is the name of the package directory."
652 (package-generate-autoloads name pkg-dir) 689 (let ((auto-name (package-generate-autoloads name pkg-dir))
653 (let ((load-path (cons pkg-dir load-path))) 690 (load-path (cons pkg-dir load-path)))
654 ;; We must load the autoloads file before byte compiling, in 691 ;; We must load the autoloads file before byte compiling, in
655 ;; case there are magic cookies to set up non-trivial paths. 692 ;; case there are magic cookies to set up non-trivial paths.
656 (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) 693 (load auto-name nil t)
694 ;; FIXME: Compilation should be done as a separate, optional, step.
695 ;; E.g. for multi-package installs, we should first install all packages
696 ;; and then compile them.
657 (byte-recompile-directory pkg-dir 0 t))) 697 (byte-recompile-directory pkg-dir 0 t)))
658 698
659(defun package--write-file-no-coding (file-name) 699(defun package--write-file-no-coding (file-name)
660 (let ((buffer-file-coding-system 'no-conversion)) 700 (let ((buffer-file-coding-system 'no-conversion))
661 (write-region (point-min) (point-max) file-name))) 701 (write-region (point-min) (point-max) file-name)))
662 702
663(defun package-unpack-single (file-name version desc requires) 703(defun package-unpack-single (name version desc requires)
664 "Install the contents of the current buffer as a package." 704 "Install the contents of the current buffer as a package."
665 ;; Special case "package". 705 ;; Special case "package". FIXME: Should this still be supported?
666 (if (string= file-name "package") 706 (if (eq name 'package)
667 (package--write-file-no-coding 707 (package--write-file-no-coding
668 (expand-file-name (concat file-name ".el") package-user-dir)) 708 (expand-file-name (format "%s.el" name) package-user-dir))
669 (let* ((pkg-dir (expand-file-name (concat file-name "-" 709 (let* ((pkg-dir (expand-file-name (format "%s-%s" name
670 (package-version-join 710 (package-version-join
671 (version-to-list version))) 711 (version-to-list version)))
672 package-user-dir)) 712 package-user-dir))
673 (el-file (expand-file-name (concat file-name ".el") pkg-dir)) 713 (el-file (expand-file-name (format "%s.el" name) pkg-dir))
674 (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) 714 (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir)))
675 (make-directory pkg-dir t) 715 (make-directory pkg-dir t)
676 (package--write-file-no-coding el-file) 716 (package--write-file-no-coding el-file)
677 (let ((print-level nil) 717 (let ((print-level nil)
718 (print-quoted t)
678 (print-length nil)) 719 (print-length nil))
679 (write-region 720 (write-region
680 (concat 721 (concat
681 (prin1-to-string 722 (prin1-to-string
682 (list 'define-package 723 (list 'define-package
683 file-name 724 (symbol-name name)
684 version 725 version
685 desc 726 desc
686 (list 'quote 727 (when requires ;Don't bother quoting nil.
687 ;; Turn version lists into string form. 728 (list 'quote
688 (mapcar 729 ;; Turn version lists into string form.
689 (lambda (elt) 730 (mapcar
690 (list (car elt) 731 (lambda (elt)
691 (package-version-join (cadr elt)))) 732 (list (car elt)
692 requires)))) 733 (package-version-join (cadr elt))))
734 requires)))))
693 "\n") 735 "\n")
694 nil 736 nil
695 pkg-file 737 pkg-file
696 nil nil nil 'excl)) 738 nil nil nil 'excl))
697 (package--make-autoloads-and-compile file-name pkg-dir)))) 739 (package--make-autoloads-and-compile name pkg-dir))))
698 740
699(defmacro package--with-work-buffer (location file &rest body) 741(defmacro package--with-work-buffer (location file &rest body)
700 "Run BODY in a buffer containing the contents of FILE at LOCATION. 742 "Run BODY in a buffer containing the contents of FILE at LOCATION.
@@ -744,7 +786,7 @@ It will move point to somewhere in the headers."
744 (let ((location (package-archive-base name)) 786 (let ((location (package-archive-base name))
745 (file (concat (symbol-name name) "-" version ".el"))) 787 (file (concat (symbol-name name) "-" version ".el")))
746 (package--with-work-buffer location file 788 (package--with-work-buffer location file
747 (package-unpack-single (symbol-name name) version desc requires)))) 789 (package-unpack-single name version desc requires))))
748 790
749(defun package-download-tar (name version) 791(defun package-download-tar (name version)
750 "Download and install a tar package." 792 "Download and install a tar package."
@@ -762,7 +804,7 @@ MIN-VERSION should be a version list."
762 (let ((pkg-desc (assq package package-alist))) 804 (let ((pkg-desc (assq package package-alist)))
763 (if pkg-desc 805 (if pkg-desc
764 (version-list-<= min-version 806 (version-list-<= min-version
765 (package-desc-vers (cdr pkg-desc))) 807 (package-desc-version (cdr pkg-desc)))
766 ;; Also check built-in packages. 808 ;; Also check built-in packages.
767 (package-built-in-p package min-version)))) 809 (package-built-in-p package min-version))))
768 810
@@ -785,7 +827,7 @@ not included in this list."
785 (unless (package-installed-p next-pkg next-version) 827 (unless (package-installed-p next-pkg next-version)
786 ;; A package is required, but not installed. It might also be 828 ;; A package is required, but not installed. It might also be
787 ;; blocked via `package-load-list'. 829 ;; blocked via `package-load-list'.
788 (let ((pkg-desc (assq next-pkg package-archive-contents)) 830 (let ((pkg-desc (cdr (assq next-pkg package-archive-contents)))
789 hold) 831 hold)
790 (when (setq hold (assq next-pkg package-load-list)) 832 (when (setq hold (assq next-pkg package-load-list))
791 (setq hold (cadr hold)) 833 (setq hold (cadr hold))
@@ -805,17 +847,17 @@ but version %s required"
805 (symbol-name next-pkg) 847 (symbol-name next-pkg)
806 (package-version-join next-version))) 848 (package-version-join next-version)))
807 (unless (version-list-<= next-version 849 (unless (version-list-<= next-version
808 (package-desc-vers (cdr pkg-desc))) 850 (package-desc-version pkg-desc))
809 (error 851 (error
810 "Need package `%s-%s', but only %s is available" 852 "Need package `%s-%s', but only %s is available"
811 (symbol-name next-pkg) (package-version-join next-version) 853 (symbol-name next-pkg) (package-version-join next-version)
812 (package-version-join (package-desc-vers (cdr pkg-desc))))) 854 (package-version-join (package-desc-version pkg-desc))))
813 ;; Move to front, so it gets installed early enough (bug#14082). 855 ;; Move to front, so it gets installed early enough (bug#14082).
814 (setq package-list (cons next-pkg (delq next-pkg package-list))) 856 (setq package-list (cons next-pkg (delq next-pkg package-list)))
815 (setq package-list 857 (setq package-list
816 (package-compute-transaction package-list 858 (package-compute-transaction package-list
817 (package-desc-reqs 859 (package-desc-reqs
818 (cdr pkg-desc)))))))) 860 pkg-desc)))))))
819 package-list) 861 package-list)
820 862
821(defun package-read-from-string (str) 863(defun package-read-from-string (str)
@@ -867,13 +909,29 @@ If the archive version is too new, signal an error."
867 (dolist (package contents) 909 (dolist (package contents)
868 (package--add-to-archive-contents package archive))))) 910 (package--add-to-archive-contents package archive)))))
869 911
912;; Package descriptor objects used inside the "archive-contents" file.
913;; Changing this defstruct implies changing the format of the
914;; "archive-contents" files.
915(cl-defstruct (package--ac-desc
916 (:constructor package-make-ac-desc (version reqs summary kind))
917 (:copier nil)
918 (:type vector))
919 version reqs summary kind)
920
870(defun package--add-to-archive-contents (package archive) 921(defun package--add-to-archive-contents (package archive)
871 "Add the PACKAGE from the given ARCHIVE if necessary. 922 "Add the PACKAGE from the given ARCHIVE if necessary.
872Also, add the originating archive to the end of the package vector." 923PACKAGE should have the form (NAME . PACKAGE--AC-DESC).
873 (let* ((name (car package)) 924Also, add the originating archive to the `package-desc' structure."
874 (version (package-desc-vers (cdr package))) 925 (let* ((name (car package))
875 (entry (cons name 926 (pkg-desc
876 (vconcat (cdr package) (vector archive)))) 927 (package-desc-create
928 :name name
929 :version (package--ac-desc-version (cdr package))
930 :reqs (package--ac-desc-reqs (cdr package))
931 :summary (package--ac-desc-summary (cdr package))
932 :kind (package--ac-desc-kind (cdr package))
933 :archive archive))
934 (entry (cons name pkg-desc))
877 (existing-package (assq name package-archive-contents)) 935 (existing-package (assq name package-archive-contents))
878 (pinned-to-archive (assoc name package-pinned-packages))) 936 (pinned-to-archive (assoc name package-pinned-packages)))
879 (cond ((and pinned-to-archive 937 (cond ((and pinned-to-archive
@@ -881,9 +939,9 @@ Also, add the originating archive to the end of the package vector."
881 (not (equal (cdr pinned-to-archive) archive))) 939 (not (equal (cdr pinned-to-archive) archive)))
882 nil) 940 nil)
883 ((not existing-package) 941 ((not existing-package)
884 (add-to-list 'package-archive-contents entry)) 942 (push entry package-archive-contents))
885 ((version-list-< (package-desc-vers (cdr existing-package)) 943 ((version-list-< (package-desc-version (cdr existing-package))
886 version) 944 (package-desc-version pkg-desc))
887 ;; Replace the entry with this one. 945 ;; Replace the entry with this one.
888 (setq package-archive-contents 946 (setq package-archive-contents
889 (cons entry 947 (cons entry
@@ -902,14 +960,14 @@ using `package-compute-transaction'."
902 ;; `package-load-list', download the held version. 960 ;; `package-load-list', download the held version.
903 (hold (cadr (assq elt package-load-list))) 961 (hold (cadr (assq elt package-load-list)))
904 (v-string (or (and (stringp hold) hold) 962 (v-string (or (and (stringp hold) hold)
905 (package-version-join (package-desc-vers desc)))) 963 (package-version-join (package-desc-version desc))))
906 (kind (package-desc-kind desc))) 964 (kind (package-desc-kind desc)))
907 (cond 965 (cond
908 ((eq kind 'tar) 966 ((eq kind 'tar)
909 (package-download-tar elt v-string)) 967 (package-download-tar elt v-string))
910 ((eq kind 'single) 968 ((eq kind 'single)
911 (package-download-single elt v-string 969 (package-download-single elt v-string
912 (package-desc-doc desc) 970 (package-desc-summary desc)
913 (package-desc-reqs desc))) 971 (package-desc-reqs desc)))
914 (t 972 (t
915 (error "Unknown package kind: %s" (symbol-name kind)))) 973 (error "Unknown package kind: %s" (symbol-name kind))))
@@ -961,17 +1019,7 @@ Otherwise return nil."
961 (error nil)))) 1019 (error nil))))
962 1020
963(defun package-buffer-info () 1021(defun package-buffer-info ()
964 "Return a vector describing the package in the current buffer. 1022 "Return a `package-desc' describing the package in the current buffer.
965The vector has the form
966
967 [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY]
968
969FILENAME is the file name, a string, sans the \".el\" extension.
970REQUIRES is a list of requirements, each requirement having the
971 form (NAME VER); NAME is a string and VER is a version list.
972DESCRIPTION is the package description, a string.
973VERSION is the version, a string.
974COMMENTARY is the commentary section, a string, or nil if none.
975 1023
976If the buffer does not contain a conforming package, signal an 1024If the buffer does not contain a conforming package, signal an
977error. If there is a package, narrow the buffer to the file's 1025error. If there is a package, narrow the buffer to the file's
@@ -990,25 +1038,18 @@ boundaries."
990 (require 'lisp-mnt) 1038 (require 'lisp-mnt)
991 ;; Use some headers we've invented to drive the process. 1039 ;; Use some headers we've invented to drive the process.
992 (let* ((requires-str (lm-header "package-requires")) 1040 (let* ((requires-str (lm-header "package-requires"))
993 (requires (if requires-str
994 (package-read-from-string requires-str)))
995 ;; Prefer Package-Version; if defined, the package author 1041 ;; Prefer Package-Version; if defined, the package author
996 ;; probably wants us to use it. Otherwise try Version. 1042 ;; probably wants us to use it. Otherwise try Version.
997 (pkg-version 1043 (pkg-version
998 (or (package-strip-rcs-id (lm-header "package-version")) 1044 (or (package-strip-rcs-id (lm-header "package-version"))
999 (package-strip-rcs-id (lm-header "version")))) 1045 (package-strip-rcs-id (lm-header "version")))))
1000 (commentary (lm-commentary)))
1001 (unless pkg-version 1046 (unless pkg-version
1002 (error 1047 (error
1003 "Package lacks a \"Version\" or \"Package-Version\" header")) 1048 "Package lacks a \"Version\" or \"Package-Version\" header"))
1004 ;; Turn string version numbers into list form. 1049 (package-desc-from-define
1005 (setq requires 1050 file-name pkg-version desc
1006 (mapcar 1051 (if requires-str (package-read-from-string requires-str))
1007 (lambda (elt) 1052 :kind 'single))))
1008 (list (car elt)
1009 (version-to-list (car (cdr elt)))))
1010 requires))
1011 (vector file-name requires desc pkg-version commentary))))
1012 1053
1013(defun package-tar-file-info (file) 1054(defun package-tar-file-info (file)
1014 "Find package information for a tar file. 1055 "Find package information for a tar file.
@@ -1025,67 +1066,46 @@ The return result is a vector like `package-buffer-info'."
1025 (pkg-def-contents (shell-command-to-string 1066 (pkg-def-contents (shell-command-to-string
1026 ;; Requires GNU tar. 1067 ;; Requires GNU tar.
1027 (concat "tar -xOf " file " " 1068 (concat "tar -xOf " file " "
1028
1029 pkg-name "-" pkg-version "/" 1069 pkg-name "-" pkg-version "/"
1030 pkg-name "-pkg.el"))) 1070 pkg-name "-pkg.el")))
1031 (pkg-def-parsed (package-read-from-string pkg-def-contents))) 1071 (pkg-def-parsed (package-read-from-string pkg-def-contents)))
1032 (unless (eq (car pkg-def-parsed) 'define-package) 1072 (unless (eq (car pkg-def-parsed) 'define-package)
1033 (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) 1073 (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
1034 (let ((name-str (nth 1 pkg-def-parsed)) 1074 (let ((pkg-desc
1035 (version-string (nth 2 pkg-def-parsed)) 1075 (apply #'package-desc-from-define (append (cdr pkg-def-parsed)
1036 (docstring (nth 3 pkg-def-parsed)) 1076 '(:kind tar)))))
1037 (requires (nth 4 pkg-def-parsed)) 1077 (unless (equal pkg-version
1038 (readme (shell-command-to-string 1078 (package-version-join (package-desc-version pkg-desc)))
1039 ;; Requires GNU tar.
1040 (concat "tar -xOf " file " "
1041 pkg-name "-" pkg-version "/README"))))
1042 (unless (equal pkg-version version-string)
1043 (error "Package has inconsistent versions")) 1079 (error "Package has inconsistent versions"))
1044 (unless (equal pkg-name name-str) 1080 (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc)))
1045 (error "Package has inconsistent names")) 1081 (error "Package has inconsistent names"))
1046 ;; Kind of a hack. 1082 pkg-desc))))
1047 (if (string-match ": Not found in archive" readme) 1083
1048 (setq readme nil))
1049 ;; Turn string version numbers into list form.
1050 (if (eq (car requires) 'quote)
1051 (setq requires (car (cdr requires))))
1052 (setq requires
1053 (mapcar (lambda (elt)
1054 (list (car elt)
1055 (version-to-list (cadr elt))))
1056 requires))
1057 (vector pkg-name requires docstring version-string readme)))))
1058 1084
1059;;;###autoload 1085;;;###autoload
1060(defun package-install-from-buffer (pkg-info type) 1086(defun package-install-from-buffer (pkg-desc)
1061 "Install a package from the current buffer. 1087 "Install a package from the current buffer.
1062When called interactively, the current buffer is assumed to be a 1088When called interactively, the current buffer is assumed to be a
1063single .el file that follows the packaging guidelines; see info 1089single .el file that follows the packaging guidelines; see info
1064node `(elisp)Packaging'. 1090node `(elisp)Packaging'.
1065 1091
1066When called from Lisp, PKG-INFO is a vector describing the 1092When called from Lisp, PKG-DESC is a `package-desc' describing the
1067information, of the type returned by `package-buffer-info'; and 1093information)."
1068TYPE is the package type (either `single' or `tar')." 1094 (interactive (list (package-buffer-info)))
1069 (interactive (list (package-buffer-info) 'single))
1070 (save-excursion 1095 (save-excursion
1071 (save-restriction 1096 (save-restriction
1072 (let* ((file-name (aref pkg-info 0)) 1097 (let* ((name (package-desc-name pkg-desc))
1073 (requires (aref pkg-info 1)) 1098 (requires (package-desc-reqs pkg-desc))
1074 (desc (if (string= (aref pkg-info 2) "") 1099 (desc (package-desc-summary pkg-desc))
1075 "No description available." 1100 (pkg-version (package-desc-version pkg-desc)))
1076 (aref pkg-info 2)))
1077 (pkg-version (aref pkg-info 3)))
1078 ;; Download and install the dependencies. 1101 ;; Download and install the dependencies.
1079 (let ((transaction (package-compute-transaction nil requires))) 1102 (let ((transaction (package-compute-transaction nil requires)))
1080 (package-download-transaction transaction)) 1103 (package-download-transaction transaction))
1081 ;; Install the package itself. 1104 ;; Install the package itself.
1082 (cond 1105 (pcase (package-desc-kind pkg-desc)
1083 ((eq type 'single) 1106 (`single (package-unpack-single name pkg-version desc requires))
1084 (package-unpack-single file-name pkg-version desc requires)) 1107 (`tar (package-unpack name pkg-version))
1085 ((eq type 'tar) 1108 (type (error "Unknown type: %S" type)))
1086 (package-unpack (intern file-name) pkg-version))
1087 (t
1088 (error "Unknown type: %s" (symbol-name type))))
1089 ;; Try to activate it. 1109 ;; Try to activate it.
1090 (package-initialize))))) 1110 (package-initialize)))))
1091 1111
@@ -1097,10 +1117,10 @@ The file can either be a tar file or an Emacs Lisp file."
1097 (with-temp-buffer 1117 (with-temp-buffer
1098 (insert-file-contents-literally file) 1118 (insert-file-contents-literally file)
1099 (cond 1119 (cond
1100 ((string-match "\\.el$" file) 1120 ((string-match "\\.el\\'" file)
1101 (package-install-from-buffer (package-buffer-info) 'single)) 1121 (package-install-from-buffer (package-buffer-info)))
1102 ((string-match "\\.tar$" file) 1122 ((string-match "\\.tar\\'" file)
1103 (package-install-from-buffer (package-tar-file-info file) 'tar)) 1123 (package-install-from-buffer (package-tar-file-info file)))
1104 (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) 1124 (t (error "Unrecognized extension `%s'" (file-name-extension file))))))
1105 1125
1106(defun package-delete (name version) 1126(defun package-delete (name version)
@@ -1118,7 +1138,7 @@ The file can either be a tar file or an Emacs Lisp file."
1118(defun package-archive-base (name) 1138(defun package-archive-base (name)
1119 "Return the archive containing the package NAME." 1139 "Return the archive containing the package NAME."
1120 (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) 1140 (let ((desc (cdr (assq (intern-soft name) package-archive-contents))))
1121 (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) 1141 (cdr (assoc (package-desc-archive desc) package-archives))))
1122 1142
1123(defun package--download-one-archive (archive file) 1143(defun package--download-one-archive (archive file)
1124 "Retrieve an archive file FILE from ARCHIVE, and cache it. 1144 "Retrieve an archive file FILE from ARCHIVE, and cache it.
@@ -1163,7 +1183,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
1163 (package-read-all-archive-contents) 1183 (package-read-all-archive-contents)
1164 (unless no-activate 1184 (unless no-activate
1165 (dolist (elt package-alist) 1185 (dolist (elt package-alist)
1166 (package-activate (car elt) (package-desc-vers (cdr elt))))) 1186 (package-activate (car elt) (package-desc-version (cdr elt)))))
1167 (setq package--initialized t)) 1187 (setq package--initialized t))
1168 1188
1169 1189
@@ -1210,22 +1230,22 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
1210 (cond 1230 (cond
1211 ;; Loaded packages are in `package-alist'. 1231 ;; Loaded packages are in `package-alist'.
1212 ((setq desc (cdr (assq package package-alist))) 1232 ((setq desc (cdr (assq package package-alist)))
1213 (setq version (package-version-join (package-desc-vers desc))) 1233 (setq version (package-version-join (package-desc-version desc)))
1214 (if (setq pkg-dir (package--dir package-name version)) 1234 (if (setq pkg-dir (package--dir package-name version))
1215 (insert "an installed package.\n\n") 1235 (insert "an installed package.\n\n")
1216 ;; This normally does not happen. 1236 ;; This normally does not happen.
1217 (insert "a deleted package.\n\n"))) 1237 (insert "a deleted package.\n\n")))
1218 ;; Available packages are in `package-archive-contents'. 1238 ;; Available packages are in `package-archive-contents'.
1219 ((setq desc (cdr (assq package package-archive-contents))) 1239 ((setq desc (cdr (assq package package-archive-contents)))
1220 (setq version (package-version-join (package-desc-vers desc)) 1240 (setq version (package-version-join (package-desc-version desc))
1221 archive (aref desc (- (length desc) 1)) 1241 archive (package-desc-archive desc)
1222 installable t) 1242 installable t)
1223 (if built-in 1243 (if built-in
1224 (insert "a built-in package.\n\n") 1244 (insert "a built-in package.\n\n")
1225 (insert "an uninstalled package.\n\n"))) 1245 (insert "an uninstalled package.\n\n")))
1226 (built-in 1246 (built-in
1227 (setq desc (cdr built-in) 1247 (setq desc (package--from-builtin built-in)
1228 version (package-version-join (package-desc-vers desc))) 1248 version (package-version-join (package-desc-version desc)))
1229 (insert "a built-in package.\n\n")) 1249 (insert "a built-in package.\n\n"))
1230 (t 1250 (t
1231 (insert "an orphan package.\n\n"))) 1251 (insert "an orphan package.\n\n")))
@@ -1246,7 +1266,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
1246 (insert "'."))) 1266 (insert "'.")))
1247 (installable 1267 (installable
1248 (if built-in 1268 (if built-in
1249 (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) 1269 (insert (propertize "Built-in."
1270 'font-lock-face 'font-lock-builtin-face)
1250 " Alternate version available") 1271 " Alternate version available")
1251 (insert "Available")) 1272 (insert "Available"))
1252 (insert " from " archive) 1273 (insert " from " archive)
@@ -1261,7 +1282,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
1261 'package-symbol package 1282 'package-symbol package
1262 'action 'package-install-button-action))) 1283 'action 'package-install-button-action)))
1263 (built-in 1284 (built-in
1264 (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) 1285 (insert (propertize "Built-in."
1286 'font-lock-face 'font-lock-builtin-face)))
1265 (t (insert "Deleted."))) 1287 (t (insert "Deleted.")))
1266 (insert "\n") 1288 (insert "\n")
1267 (and version (> (length version) 0) 1289 (and version (> (length version) 0)
@@ -1286,7 +1308,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
1286 (help-insert-xref-button text 'help-package name)) 1308 (help-insert-xref-button text 'help-package name))
1287 (insert "\n"))) 1309 (insert "\n")))
1288 (insert " " (propertize "Summary" 'font-lock-face 'bold) 1310 (insert " " (propertize "Summary" 'font-lock-face 'bold)
1289 ": " (if desc (package-desc-doc desc)) "\n\n") 1311 ": " (if desc (package-desc-summary desc)) "\n\n")
1290 1312
1291 (if built-in 1313 (if built-in
1292 ;; For built-in packages, insert the commentary. 1314 ;; For built-in packages, insert the commentary.
@@ -1418,10 +1440,10 @@ If the alist stored in the symbol LISTNAME lacks an entry for a
1418package PACKAGE with descriptor DESC, add one. The alist is 1440package PACKAGE with descriptor DESC, add one. The alist is
1419keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is 1441keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is
1420a symbol and VERSION-LIST is a version list." 1442a symbol and VERSION-LIST is a version list."
1421 `(let* ((version (package-desc-vers ,desc)) 1443 `(let* ((version (package-desc-version ,desc))
1422 (key (cons ,package version))) 1444 (key (cons ,package version)))
1423 (unless (assoc key ,listname) 1445 (unless (assoc key ,listname)
1424 (push (list key ,status (package-desc-doc ,desc)) ,listname)))) 1446 (push (list key ,status (package-desc-summary ,desc)) ,listname))))
1425 1447
1426(defun package-menu--generate (remember-pos packages) 1448(defun package-menu--generate (remember-pos packages)
1427 "Populate the Package Menu. 1449 "Populate the Package Menu.
@@ -1444,7 +1466,7 @@ or a list of package names (symbols) to display."
1444 (setq name (car elt)) 1466 (setq name (car elt))
1445 (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. 1467 (when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
1446 (or (eq packages t) (memq name packages))) 1468 (or (eq packages t) (memq name packages)))
1447 (package--push name (cdr elt) "built-in" info-list))) 1469 (package--push name (package--from-builtin elt) "built-in" info-list)))
1448 1470
1449 ;; Available and disabled packages: 1471 ;; Available and disabled packages:
1450 (dolist (elt package-archive-contents) 1472 (dolist (elt package-archive-contents)
diff --git a/lisp/finder.el b/lisp/finder.el
index 3d988b41bde..f6593c554eb 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -206,7 +206,8 @@ from; the default is `load-path'."
206 (setq version (ignore-errors (version-to-list version))) 206 (setq version (ignore-errors (version-to-list version)))
207 (setq entry (assq package package--builtins)) 207 (setq entry (assq package package--builtins))
208 (cond ((null entry) 208 (cond ((null entry)
209 (push (cons package (vector version nil summary)) 209 (push (cons package
210 (package-make-builtin version summary))
210 package--builtins)) 211 package--builtins))
211 ((eq base-name package) 212 ((eq base-name package)
212 (setq desc (cdr entry)) 213 (setq desc (cdr entry))