diff options
| -rw-r--r-- | lisp/ChangeLog | 30 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package-x.el | 63 | ||||
| -rw-r--r-- | lisp/emacs-lisp/package.el | 378 | ||||
| -rw-r--r-- | lisp/finder.el | 3 |
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 @@ | |||
| 1 | 2013-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 | |||
| 1 | 2013-06-11 Stefan Monnier <monnier@iro.umontreal.ca> | 31 | 2013-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. |
| 167 | PKG-INFO is the package info, see `package-buffer-info'. | 169 | PKG-DESC is the `package-desc'. |
| 168 | EXTENSION is the file extension, a string. It can be either | 170 | EXTENSION 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. |
| 265 | This is an alist mapping package names (symbols) to package | 267 | This is an alist mapping package names (symbols) to |
| 266 | descriptor vectors. These are like the vectors for `package-alist' | 268 | `package--desc' structures.") |
| 267 | but have extra entries: one which is 'tar for tar packages and | ||
| 268 | 'single for single-file packages, and one which is the name of | ||
| 269 | the 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 | |||
| 322 | Slots: | ||
| 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 | ||
| 329 | the first line of the file. | ||
| 330 | |||
| 331 | `reqs' Requirements of the package. A list of (PACKAGE | ||
| 332 | VERSION-LIST) naming the dependent package and the minimum | ||
| 333 | required version. | ||
| 334 | |||
| 335 | `kind' The distribution format of the package. Currently, it is | ||
| 336 | either `single' or `tar'. | ||
| 337 | |||
| 338 | `archive' The name of the archive (as a string) whence this | ||
| 339 | package 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 |
| 306 | function `package-built-in-p'. | 361 | function `package-built-in-p'. |
| 307 | 362 | ||
| 308 | Each element has the form (PKG . DESC), where PKG is a package | 363 | Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package |
| 309 | name (a symbol) and DESC is a vector that describes the package. | 364 | name (a symbol) and DESC is a `package--bi-desc' structure.") |
| 310 | The 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. |
| 320 | Each element has the form (PKG . DESC), where PKG is a package | 369 | Each element has the form (PKG . DESC), where PKG is a package |
| 321 | name (a symbol) and DESC is a vector that describes the package. | 370 | name (a symbol) and DESC is a `package-desc' structure. |
| 322 | |||
| 323 | The 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 | ||
| 330 | This variable is set automatically by `package-load-descriptor', | 372 | This variable is set automatically by `package-load-descriptor', |
| 331 | called via `package-initialize'. To change which packages are | 373 | called 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. |
| 341 | Like `package-alist', but maps package name to a second alist. | 383 | Like `package-alist', but maps package name to a second alist. |
| 342 | The inner alist is keyed by version.") | 384 | The inner alist is keyed by version. |
| 385 | |||
| 386 | Each element of the list is (NAME . VERSION-ALIST), where each | ||
| 387 | entry 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. |
| 451 | NAME and VERSION are both strings." | 486 | NAME 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." | |||
| 525 | Required package `%s-%s' is unavailable" | 565 | Required 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. | |||
| 555 | EXTRA-PROPERTIES is currently unused." | 595 | EXTRA-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. |
| 651 | PKG-DIR is the name of the package directory." | 688 | PKG-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. |
| 872 | Also, add the originating archive to the end of the package vector." | 923 | PACKAGE should have the form (NAME . PACKAGE--AC-DESC). |
| 873 | (let* ((name (car package)) | 924 | Also, 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. |
| 965 | The vector has the form | ||
| 966 | |||
| 967 | [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] | ||
| 968 | |||
| 969 | FILENAME is the file name, a string, sans the \".el\" extension. | ||
| 970 | REQUIRES is a list of requirements, each requirement having the | ||
| 971 | form (NAME VER); NAME is a string and VER is a version list. | ||
| 972 | DESCRIPTION is the package description, a string. | ||
| 973 | VERSION is the version, a string. | ||
| 974 | COMMENTARY is the commentary section, a string, or nil if none. | ||
| 975 | 1023 | ||
| 976 | If the buffer does not contain a conforming package, signal an | 1024 | If the buffer does not contain a conforming package, signal an |
| 977 | error. If there is a package, narrow the buffer to the file's | 1025 | error. 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. |
| 1062 | When called interactively, the current buffer is assumed to be a | 1088 | When called interactively, the current buffer is assumed to be a |
| 1063 | single .el file that follows the packaging guidelines; see info | 1089 | single .el file that follows the packaging guidelines; see info |
| 1064 | node `(elisp)Packaging'. | 1090 | node `(elisp)Packaging'. |
| 1065 | 1091 | ||
| 1066 | When called from Lisp, PKG-INFO is a vector describing the | 1092 | When called from Lisp, PKG-DESC is a `package-desc' describing the |
| 1067 | information, of the type returned by `package-buffer-info'; and | 1093 | information)." |
| 1068 | TYPE 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 | |||
| 1418 | package PACKAGE with descriptor DESC, add one. The alist is | 1440 | package PACKAGE with descriptor DESC, add one. The alist is |
| 1419 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is | 1441 | keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is |
| 1420 | a symbol and VERSION-LIST is a version list." | 1442 | a 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)) |