From: Stefan Monnier Date: Wed, 12 Jun 2013 00:49:33 +0000 (-0400) Subject: First part of Daniel Hackney's patch to package.el. X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2016^2~145^2~14 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f56be016d5d2d550f98c83a9d4e61468c71738c2;p=emacs.git First part of Daniel Hackney's patch to package.el. * lisp/emacs-lisp/package.el: Use defstruct. (package-desc): New, main struct. (package--bi-desc, package--ac-desc): New structs, used to describe the format in external files. (package-desc-vers): Replace with package-desc-version accessor. (package-desc-doc): Replace with package-desc-summary accessor. (package-activate-1): Remove `package' arg since the pkg-vec now includes the name. (define-package): Use package-desc-from-define. (package-unpack-single): Change file-name arg to be a symbol. (package--add-to-archive-contents): Use package-desc-create and new accessor functions to package--ac-desc. (package-buffer-info, package-tar-file-info): Return a package-desc. (package-install-from-buffer): Remove `type' argument. Change pkg-info arg to be a package-desc. (package-install-file): Adjust accordingly. Use \' to match EOS. (package--from-builtin): New function. (describe-package-1, package-menu--generate): Use it. (package--make-autoloads-and-compile): Change name arg to be a symbol. (package-generate-autoloads): Idem and return the name of the file. * lisp/emacs-lisp/package-x.el (package-upload-buffer-internal): Change pkg-info arg to be a package-desc. Use package-make-ac-desc. (package-upload-file): Use \' to match EOS. * lisp/finder.el (finder-compile-keywords): Use package-make-builtin. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 10d706ad81c..ff4c2fb4444 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,33 @@ +2013-06-12 Stefan Monnier + Daniel Hackney + + First part of Daniel Hackney's patch to package.el. + * emacs-lisp/package.el: Use defstruct. + (package-desc): New, main struct. + (package--bi-desc, package--ac-desc): New structs, used to describe the + format in external files. + (package-desc-vers): Replace with package-desc-version accessor. + (package-desc-doc): Replace with package-desc-summary accessor. + (package-activate-1): Remove `package' arg since the pkg-vec now + includes the name. + (define-package): Use package-desc-from-define. + (package-unpack-single): Change file-name arg to be a symbol. + (package--add-to-archive-contents): Use package-desc-create and new + accessor functions to package--ac-desc. + (package-buffer-info, package-tar-file-info): Return a package-desc. + (package-install-from-buffer): Remove `type' argument. Change pkg-info + arg to be a package-desc. + (package-install-file): Adjust accordingly. Use \' to match EOS. + (package--from-builtin): New function. + (describe-package-1, package-menu--generate): Use it. + (package--make-autoloads-and-compile): Change name arg to be a symbol. + (package-generate-autoloads): Idem and return the name of the file. + * emacs-lisp/package-x.el (package-upload-buffer-internal): + Change pkg-info arg to be a package-desc. + Use package-make-ac-desc. + (package-upload-file): Use \' to match EOS. + * finder.el (finder-compile-keywords): Use package-make-builtin. + 2013-06-11 Stefan Monnier * 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." description archive-url)) -(defun package-upload-buffer-internal (pkg-info extension &optional archive-url) +(declare-function lm-commentary "lisp-mnt" (&optional file)) + +(defun package-upload-buffer-internal (pkg-desc extension &optional archive-url) "Upload a package whose contents are in the current buffer. -PKG-INFO is the package info, see `package-buffer-info'. +PKG-DESC is the `package-desc'. EXTENSION is the file extension, a string. It can be either \"el\" or \"tar\". @@ -196,18 +198,18 @@ if it exists." (error "Aborted"))) (save-excursion (save-restriction - (let* ((file-type (cond - ((equal extension "el") 'single) - ((equal extension "tar") 'tar) - (t (error "Unknown extension `%s'" extension)))) - (file-name (aref pkg-info 0)) - (pkg-name (intern file-name)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") + (let* ((file-type (package-desc-kind pkg-desc)) + (pkg-name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (desc (if (eq (package-desc-summary pkg-desc) + package--default-summary) (read-string "Description of package: ") - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3)) - (commentary (aref pkg-info 4)) + (package-desc-summary pkg-desc))) + (pkg-version (package-desc-version pkg-desc)) + (commentary + (pcase file-type + (`single (lm-commentary)) + (`tar nil))) ;; FIXME: Get it from the README file. (split-version (version-to-list pkg-version)) (pkg-buffer (current-buffer))) @@ -215,7 +217,8 @@ if it exists." ;; from `package-archive-upload-base' otherwise. (let ((contents (or (package--archive-contents-from-url archive-url) (package--archive-contents-from-file))) - (new-desc (vector split-version requires desc file-type))) + (new-desc (package-make-ac-desc + split-version requires desc file-type))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) (let ((elt (assq pkg-name (cdr contents)))) @@ -232,6 +235,7 @@ if it exists." ;; this and the package itself. For now we assume ELPA is ;; writable via file primitives. (let ((print-level nil) + (print-quoted t) (print-length nil)) (write-region (concat (pp-to-string contents) "\n") nil @@ -241,29 +245,29 @@ if it exists." ;; If there is a commentary section, write it. (when commentary (write-region commentary nil - (expand-file-name - (concat (symbol-name pkg-name) "-readme.txt") - package-archive-upload-base))) + (expand-file-name + (concat (symbol-name pkg-name) "-readme.txt") + package-archive-upload-base))) (set-buffer pkg-buffer) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "-" pkg-version "." extension) + (format "%s-%s.%s" pkg-name pkg-version extension) package-archive-upload-base) nil nil nil 'excl) ;; Write a news entry. (and package-update-news-on-upload archive-url - (package--update-news (concat file-name "." extension) + (package--update-news (format "%s.%s" pkg-name extension) pkg-version desc archive-url)) ;; special-case "package": write a second copy so that the ;; installer can easily find the latest version. - (if (string= file-name "package") + (if (eq pkg-name 'package) (write-region (point-min) (point-max) (expand-file-name - (concat file-name "." extension) + (format "%s.%s" pkg-name extension) package-archive-upload-base) nil nil nil 'ask)))))))) @@ -275,8 +279,8 @@ destination, prompt for one." (save-excursion (save-restriction ;; Find the package in this buffer. - (let ((pkg-info (package-buffer-info))) - (package-upload-buffer-internal pkg-info "el"))))) + (let ((pkg-desc (package-buffer-info))) + (package-upload-buffer-internal pkg-desc "el"))))) (defun package-upload-file (file) "Upload the Emacs Lisp package FILE to the package archive. @@ -288,12 +292,13 @@ destination, prompt for one." (interactive "fPackage file name: ") (with-temp-buffer (insert-file-contents-literally file) - (let ((info (cond - ((string-match "\\.tar$" file) (package-tar-file-info file)) - ((string-match "\\.el$" file) (package-buffer-info)) - (t (error "Unrecognized extension `%s'" - (file-name-extension file)))))) - (package-upload-buffer-internal info (file-name-extension file))))) + (let ((pkg-desc + (cond + ((string-match "\\.tar\\'" file) (package-tar-file-info file)) + ((string-match "\\.el\\'" file) (package-buffer-info)) + (t (error "Unrecognized extension `%s'" + (file-name-extension file)))))) + (package-upload-buffer-internal pkg-desc (file-name-extension file))))) (defun package-gnus-summary-upload () "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 @@ ;;; Code: +(eval-when-compile (require 'cl-lib)) + (require 'tabulated-list) (defgroup package nil @@ -262,11 +264,8 @@ Lower version numbers than this will probably be understood as well.") ;; We don't prime the cache since it tends to get out of date. (defvar package-archive-contents nil "Cache of the contents of the Emacs Lisp Package Archive. -This is an alist mapping package names (symbols) to package -descriptor vectors. These are like the vectors for `package-alist' -but have extra entries: one which is 'tar for tar packages and -'single for single-file packages, and one which is the name of -the archive from which it came.") +This is an alist mapping package names (symbols) to +`package--desc' structures.") (put 'package-archive-contents 'risky-local-variable t) (defcustom package-user-dir (locate-user-emacs-file "elpa") @@ -297,6 +296,62 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") +(defvar package--default-summary "No description available.") + +(cl-defstruct (package-desc + ;; Rename the default constructor from `make-package-desc'. + (:constructor package-desc-create) + ;; Has the same interface as the old `define-package', + ;; which is still used in the "foo-pkg.el" files. Extra + ;; options can be supported by adding additional keys. + (:constructor + package-desc-from-define + (name-string version-string &optional summary requirements + &key kind archive + &aux + (name (intern name-string)) + (version (version-to-list version-string)) + (reqs (mapcar #'(lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + (if (eq 'quote (car requirements)) + (nth 1 requirements) + requirements)))))) + "Structure containing information about an individual package. + +Slots: + +`name' Name of the package, as a symbol. + +`version' Version of the package, as a version list. + +`summary' Short description of the package, typically taken from +the first line of the file. + +`reqs' Requirements of the package. A list of (PACKAGE +VERSION-LIST) naming the dependent package and the minimum +required version. + +`kind' The distribution format of the package. Currently, it is +either `single' or `tar'. + +`archive' The name of the archive (as a string) whence this +package came." + name + version + (summary package--default-summary) + reqs + kind + archive) + +;; Package descriptor format used in finder-inf.el and package--builtins. +(cl-defstruct (package--bi-desc + (:constructor package-make-builtin (version summary)) + (:type vector)) + version + reqs + summary) + ;; The value is precomputed in finder-inf.el, but don't load that ;; until it's needed (i.e. when `package-initialize' is called). (defvar package--builtins nil @@ -305,27 +360,14 @@ The actual value is initialized by loading the library `finder-inf'; this is not done until it is needed, e.g. by the function `package-built-in-p'. -Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL), where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package.") +Each element has the form (PKG . PACKAGE-BI-DESC), where PKG is a package +name (a symbol) and DESC is a `package--bi-desc' structure.") (put 'package--builtins 'risky-local-variable t) (defvar package-alist nil "Alist of all packages available for activation. Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. - -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL) where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package. +name (a symbol) and DESC is a `package-desc' structure. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are @@ -339,7 +381,10 @@ loaded and/or activated, customize `package-load-list'.") (defvar package-obsolete-alist nil "Representation of obsolete packages. Like `package-alist', but maps package name to a second alist. -The inner alist is keyed by version.") +The inner alist is keyed by version. + +Each element of the list is (NAME . VERSION-ALIST), where each +entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).") (put 'package-obsolete-alist 'risky-local-variable t) (defun package-version-join (vlist) @@ -430,26 +475,16 @@ the package by calling `package-load-descriptor'." ;; Actually load the descriptor: (package-load-descriptor dir subdir)))) -(defsubst package-desc-vers (desc) - "Extract version from a package description vector." - (aref desc 0)) +(define-obsolete-function-alias 'package-desc-vers 'package-desc-version "24.4") -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) +(define-obsolete-function-alias 'package-desc-doc 'package-desc-summary "24.4") -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector." - (aref desc 3)) (defun package--dir (name version) + ;; FIXME: Keep this as a field in the package-desc. "Return the directory where a package is installed, or nil if none. -NAME and VERSION are both strings." - (let* ((subdir (concat name "-" version)) +NAME is a symbol and VERSION is a string." + (let* ((subdir (format "%s-%s" name version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -460,9 +495,9 @@ NAME and VERSION are both strings." (setq dir-list (cdr dir-list))))) pkg-dir)) -(defun package-activate-1 (package pkg-vec) - (let* ((name (symbol-name package)) - (version-str (package-version-join (package-desc-vers pkg-vec))) +(defun package-activate-1 (pkg-desc) + (let* ((name (package-desc-name pkg-desc)) + (version-str (package-version-join (package-desc-version pkg-desc))) (pkg-dir (package--dir name version-str))) (unless pkg-dir (error "Internal error: unable to find directory for `%s-%s'" @@ -475,8 +510,8 @@ NAME and VERSION are both strings." (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. (push pkg-dir load-path) - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (push package package-activated-list) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) + (push name package-activated-list) ;; Don't return nil. t)) @@ -489,7 +524,12 @@ specifying the minimum acceptable version." (version-list-<= min-version (version-to-list emacs-version)) (let ((elt (assq package package--builtins))) (and elt (version-list-<= min-version - (package-desc-vers (cdr elt))))))) + (package--bi-desc-version (cdr elt))))))) + +(defun package--from-builtin (bi-desc) + (package-desc-create :name (pop bi-desc) + :version (package--bi-desc-version bi-desc) + :summary (package--bi-desc-summary bi-desc))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at @@ -504,7 +544,7 @@ Return nil if the package could not be activated." available-version found) ;; Check if PACKAGE is available in `package-alist'. (when pkg-vec - (setq available-version (package-desc-vers pkg-vec) + (setq available-version (package-desc-version pkg-vec) found (version-list-<= min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. @@ -525,7 +565,7 @@ Return nil if the package could not be activated." Required package `%s-%s' is unavailable" package (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 package pkg-vec))))))) + (package-activate-1 pkg-vec))))))) (defun package-mark-obsolete (package pkg-vec) "Put package on the obsolete list, if not already there." @@ -533,11 +573,11 @@ Required package `%s-%s' is unavailable" (if elt ;; If this obsolete version does not exist in the list, update ;; it the list. - (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) - (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) + (unless (assoc (package-desc-version pkg-vec) (cdr elt)) + (setcdr elt (cons (cons (package-desc-version pkg-vec) pkg-vec) (cdr elt)))) ;; Make a new association. - (push (cons package (list (cons (package-desc-vers pkg-vec) + (push (cons package (list (cons (package-desc-version pkg-vec) pkg-vec))) package-obsolete-alist)))) @@ -555,21 +595,17 @@ REQUIREMENTS is a list of dependencies on other packages. EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-string)) (version (version-to-list version-string)) - (new-pkg-desc - (cons name - (vector version - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requirements) - docstring))) + (new-pkg-desc (cons name + (package-desc-from-define name-string + version-string + docstring + requirements))) (old-pkg (assq name package-alist))) (cond ;; If there's no old package, just add this to `package-alist'. ((null old-pkg) (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) + ((version-list-< (package-desc-version (cdr old-pkg)) version) ;; Remove the old package and declare it obsolete. (package-mark-obsolete name (cdr old-pkg)) (setq package-alist (cons new-pkg-desc @@ -577,7 +613,7 @@ EXTRA-PROPERTIES is currently unused." ;; You can have two packages with the same version, e.g. one in ;; the system package directory and one in your private ;; directory. We just let the first one win. - ((not (version-list-= (package-desc-vers (cdr old-pkg)) version)) + ((not (version-list-= (package-desc-version (cdr old-pkg)) version)) ;; The package is born obsolete. (package-mark-obsolete name (cdr new-pkg-desc)))))) @@ -603,14 +639,15 @@ EXTRA-PROPERTIES is currently unused." (defun package-generate-autoloads (name pkg-dir) (require 'autoload) ;Load before we let-bind generated-autoload-file! - (let* ((auto-name (concat name "-autoloads.el")) + (let* ((auto-name (format "%s-autoloads.el" name)) ;;(ignore-name (concat name "-pkg.el")) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (package-autoload-ensure-default-file generated-autoload-file) (update-directory-autoloads pkg-dir) (let ((buf (find-buffer-visiting generated-autoload-file))) - (when buf (kill-buffer buf))))) + (when buf (kill-buffer buf))) + auto-name)) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) @@ -644,57 +681,62 @@ untar into a directory named DIR; otherwise, signal an error." ;; FIXME: should we delete PKG-DIR if it exists? (let* ((default-directory (file-name-as-directory package-user-dir))) (package-untar-buffer dirname) - (package--make-autoloads-and-compile name pkg-dir)))) + (package--make-autoloads-and-compile package pkg-dir)))) (defun package--make-autoloads-and-compile (name pkg-dir) "Generate autoloads and do byte-compilation for package named NAME. PKG-DIR is the name of the package directory." - (package-generate-autoloads name pkg-dir) - (let ((load-path (cons pkg-dir load-path))) + (let ((auto-name (package-generate-autoloads name pkg-dir)) + (load-path (cons pkg-dir load-path))) ;; We must load the autoloads file before byte compiling, in ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (load auto-name nil t) + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. (byte-recompile-directory pkg-dir 0 t))) (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name))) -(defun package-unpack-single (file-name version desc requires) +(defun package-unpack-single (name version desc requires) "Install the contents of the current buffer as a package." - ;; Special case "package". - (if (string= file-name "package") + ;; Special case "package". FIXME: Should this still be supported? + (if (eq name 'package) (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir)) - (let* ((pkg-dir (expand-file-name (concat file-name "-" + (expand-file-name (format "%s.el" name) package-user-dir)) + (let* ((pkg-dir (expand-file-name (format "%s-%s" name (package-version-join (version-to-list version))) package-user-dir)) - (el-file (expand-file-name (concat file-name ".el") pkg-dir)) - (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) + (el-file (expand-file-name (format "%s.el" name) pkg-dir)) + (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) (make-directory pkg-dir t) (package--write-file-no-coding el-file) (let ((print-level nil) + (print-quoted t) (print-length nil)) (write-region (concat (prin1-to-string (list 'define-package - file-name + (symbol-name name) version desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) + (when requires ;Don't bother quoting nil. + (list 'quote + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires))))) "\n") nil pkg-file nil nil nil 'excl)) - (package--make-autoloads-and-compile file-name pkg-dir)))) + (package--make-autoloads-and-compile name pkg-dir)))) (defmacro package--with-work-buffer (location file &rest body) "Run BODY in a buffer containing the contents of FILE at LOCATION. @@ -744,7 +786,7 @@ It will move point to somewhere in the headers." (let ((location (package-archive-base name)) (file (concat (symbol-name name) "-" version ".el"))) (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) + (package-unpack-single name version desc requires)))) (defun package-download-tar (name version) "Download and install a tar package." @@ -762,7 +804,7 @@ MIN-VERSION should be a version list." (let ((pkg-desc (assq package package-alist))) (if pkg-desc (version-list-<= min-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. (package-built-in-p package min-version)))) @@ -785,7 +827,7 @@ not included in this list." (unless (package-installed-p next-pkg next-version) ;; A package is required, but not installed. It might also be ;; blocked via `package-load-list'. - (let ((pkg-desc (assq next-pkg package-archive-contents)) + (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) hold) (when (setq hold (assq next-pkg package-load-list)) (setq hold (cadr hold)) @@ -805,17 +847,17 @@ but version %s required" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<= next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version pkg-desc)) (error "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) - (package-version-join (package-desc-vers (cdr pkg-desc))))) + (package-version-join (package-desc-version pkg-desc)))) ;; Move to front, so it gets installed early enough (bug#14082). (setq package-list (cons next-pkg (delq next-pkg package-list))) (setq package-list (package-compute-transaction package-list (package-desc-reqs - (cdr pkg-desc)))))))) + pkg-desc))))))) package-list) (defun package-read-from-string (str) @@ -867,13 +909,29 @@ If the archive version is too new, signal an error." (dolist (package contents) (package--add-to-archive-contents package archive))))) +;; Package descriptor objects used inside the "archive-contents" file. +;; Changing this defstruct implies changing the format of the +;; "archive-contents" files. +(cl-defstruct (package--ac-desc + (:constructor package-make-ac-desc (version reqs summary kind)) + (:copier nil) + (:type vector)) + version reqs summary kind) + (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. -Also, add the originating archive to the end of the package vector." - (let* ((name (car package)) - (version (package-desc-vers (cdr package))) - (entry (cons name - (vconcat (cdr package) (vector archive)))) +PACKAGE should have the form (NAME . PACKAGE--AC-DESC). +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (pkg-desc + (package-desc-create + :name name + :version (package--ac-desc-version (cdr package)) + :reqs (package--ac-desc-reqs (cdr package)) + :summary (package--ac-desc-summary (cdr package)) + :kind (package--ac-desc-kind (cdr package)) + :archive archive)) + (entry (cons name pkg-desc)) (existing-package (assq name package-archive-contents)) (pinned-to-archive (assoc name package-pinned-packages))) (cond ((and pinned-to-archive @@ -881,9 +939,9 @@ Also, add the originating archive to the end of the package vector." (not (equal (cdr pinned-to-archive) archive))) nil) ((not existing-package) - (add-to-list 'package-archive-contents entry)) - ((version-list-< (package-desc-vers (cdr existing-package)) - version) + (push entry package-archive-contents)) + ((version-list-< (package-desc-version (cdr existing-package)) + (package-desc-version pkg-desc)) ;; Replace the entry with this one. (setq package-archive-contents (cons entry @@ -902,14 +960,14 @@ using `package-compute-transaction'." ;; `package-load-list', download the held version. (hold (cadr (assq elt package-load-list))) (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) + (package-version-join (package-desc-version desc)))) (kind (package-desc-kind desc))) (cond ((eq kind 'tar) (package-download-tar elt v-string)) ((eq kind 'single) (package-download-single elt v-string - (package-desc-doc desc) + (package-desc-summary desc) (package-desc-reqs desc))) (t (error "Unknown package kind: %s" (symbol-name kind)))) @@ -961,17 +1019,7 @@ Otherwise return nil." (error nil)))) (defun package-buffer-info () - "Return a vector describing the package in the current buffer. -The vector has the form - - [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] - -FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a list of requirements, each requirement having the - form (NAME VER); NAME is a string and VER is a version list. -DESCRIPTION is the package description, a string. -VERSION is the version, a string. -COMMENTARY is the commentary section, a string, or nil if none. + "Return a `package-desc' describing the package in the current buffer. If the buffer does not contain a conforming package, signal an error. If there is a package, narrow the buffer to the file's @@ -990,25 +1038,18 @@ boundaries." (require 'lisp-mnt) ;; Use some headers we've invented to drive the process. (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) ;; Prefer Package-Version; if defined, the package author ;; probably wants us to use it. Otherwise try Version. (pkg-version (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) + (package-strip-rcs-id (lm-header "version"))))) (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (vector file-name requires desc pkg-version commentary)))) + (package-desc-from-define + file-name pkg-version desc + (if requires-str (package-read-from-string requires-str)) + :kind 'single)))) (defun package-tar-file-info (file) "Find package information for a tar file. @@ -1025,67 +1066,46 @@ The return result is a vector like `package-buffer-info'." (pkg-def-contents (shell-command-to-string ;; Requires GNU tar. (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/" pkg-name "-pkg.el"))) (pkg-def-parsed (package-read-from-string pkg-def-contents))) (unless (eq (car pkg-def-parsed) 'define-package) (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) - (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - (readme (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/README")))) - (unless (equal pkg-version version-string) + (let ((pkg-desc + (apply #'package-desc-from-define (append (cdr pkg-def-parsed) + '(:kind tar))))) + (unless (equal pkg-version + (package-version-join (package-desc-version pkg-desc))) (error "Package has inconsistent versions")) - (unless (equal pkg-name name-str) + (unless (equal pkg-name (symbol-name (package-desc-name pkg-desc))) (error "Package has inconsistent names")) - ;; Kind of a hack. - (if (string-match ": Not found in archive" readme) - (setq readme nil)) - ;; Turn string version numbers into list form. - (if (eq (car requires) 'quote) - (setq requires (car (cdr requires)))) - (setq requires - (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - requires)) - (vector pkg-name requires docstring version-string readme))))) + pkg-desc)))) + ;;;###autoload -(defun package-install-from-buffer (pkg-info type) +(defun package-install-from-buffer (pkg-desc) "Install a package from the current buffer. When called interactively, the current buffer is assumed to be a single .el file that follows the packaging guidelines; see info node `(elisp)Packaging'. -When called from Lisp, PKG-INFO is a vector describing the -information, of the type returned by `package-buffer-info'; and -TYPE is the package type (either `single' or `tar')." - (interactive (list (package-buffer-info) 'single)) +When called from Lisp, PKG-DESC is a `package-desc' describing the +information)." + (interactive (list (package-buffer-info))) (save-excursion (save-restriction - (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) - (desc (if (string= (aref pkg-info 2) "") - "No description available." - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3))) + (let* ((name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (desc (package-desc-summary pkg-desc)) + (pkg-version (package-desc-version pkg-desc))) ;; Download and install the dependencies. (let ((transaction (package-compute-transaction nil requires))) (package-download-transaction transaction)) ;; Install the package itself. - (cond - ((eq type 'single) - (package-unpack-single file-name pkg-version desc requires)) - ((eq type 'tar) - (package-unpack (intern file-name) pkg-version)) - (t - (error "Unknown type: %s" (symbol-name type)))) + (pcase (package-desc-kind pkg-desc) + (`single (package-unpack-single name pkg-version desc requires)) + (`tar (package-unpack name pkg-version)) + (type (error "Unknown type: %S" type))) ;; Try to activate it. (package-initialize))))) @@ -1097,10 +1117,10 @@ The file can either be a tar file or an Emacs Lisp file." (with-temp-buffer (insert-file-contents-literally file) (cond - ((string-match "\\.el$" file) - (package-install-from-buffer (package-buffer-info) 'single)) - ((string-match "\\.tar$" file) - (package-install-from-buffer (package-tar-file-info file) 'tar)) + ((string-match "\\.el\\'" file) + (package-install-from-buffer (package-buffer-info))) + ((string-match "\\.tar\\'" file) + (package-install-from-buffer (package-tar-file-info file))) (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) @@ -1118,7 +1138,7 @@ The file can either be a tar file or an Emacs Lisp file." (defun package-archive-base (name) "Return the archive containing the package NAME." (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + (cdr (assoc (package-desc-archive desc) package-archives)))) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. @@ -1163,7 +1183,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt) (package-desc-version (cdr elt))))) (setq package--initialized t)) @@ -1210,22 +1230,22 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (cond ;; Loaded packages are in `package-alist'. ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) + (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package--dir package-name version)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) - archive (aref desc (- (length desc) 1)) + (setq version (package-version-join (package-desc-version desc)) + archive (package-desc-archive desc) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in - (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + (setq desc (package--from-builtin built-in) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1246,7 +1266,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (insert "'."))) (installable (if built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face) " Alternate version available") (insert "Available")) (insert " from " archive) @@ -1261,7 +1282,8 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." 'package-symbol package 'action 'package-install-button-action))) (built-in - (insert (propertize "Built-in." 'font-lock-face 'font-lock-builtin-face))) + (insert (propertize "Built-in." + 'font-lock-face 'font-lock-builtin-face))) (t (insert "Deleted."))) (insert "\n") (and version (> (length version) 0) @@ -1286,7 +1308,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. @@ -1418,10 +1440,10 @@ If the alist stored in the symbol LISTNAME lacks an entry for a package PACKAGE with descriptor DESC, add one. The alist is keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is a symbol and VERSION-LIST is a version list." - `(let* ((version (package-desc-vers ,desc)) + `(let* ((version (package-desc-version ,desc)) (key (cons ,package version))) (unless (assoc key ,listname) - (push (list key ,status (package-desc-doc ,desc)) ,listname)))) + (push (list key ,status (package-desc-summary ,desc)) ,listname)))) (defun package-menu--generate (remember-pos packages) "Populate the Package Menu. @@ -1444,7 +1466,7 @@ or a list of package names (symbols) to display." (setq name (car elt)) (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. (or (eq packages t) (memq name packages))) - (package--push name (cdr elt) "built-in" info-list))) + (package--push name (package--from-builtin elt) "built-in" info-list))) ;; Available and disabled packages: (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'." (setq version (ignore-errors (version-to-list version))) (setq entry (assq package package--builtins)) (cond ((null entry) - (push (cons package (vector version nil summary)) + (push (cons package + (package-make-builtin version summary)) package--builtins)) ((eq base-name package) (setq desc (cdr entry))