From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daniel Hackney Newsgroups: gmane.emacs.devel Subject: Re: [PATCH] Re: package.el changes before the feature freeze Date: Mon, 8 Oct 2012 21:11:34 -0400 Message-ID: References: <87ipau51jh.fsf@gnu.org> <87626qk5xo.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable X-Trace: ger.gmane.org 1349745135 973 80.91.229.3 (9 Oct 2012 01:12:15 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 9 Oct 2012 01:12:15 +0000 (UTC) Cc: Chong Yidong , emacs-devel@gnu.org To: Stefan Monnier Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Oct 09 03:12:20 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1TLOMt-0005wm-7L for ged-emacs-devel@m.gmane.org; Tue, 09 Oct 2012 03:12:19 +0200 Original-Received: from localhost ([::1]:57935 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TLOMm-0005E0-RJ for ged-emacs-devel@m.gmane.org; Mon, 08 Oct 2012 21:12:12 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:56697) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TLOMd-0005Dq-UT for emacs-devel@gnu.org; Mon, 08 Oct 2012 21:12:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1TLOMX-0006fe-IZ for emacs-devel@gnu.org; Mon, 08 Oct 2012 21:12:03 -0400 Original-Received: from mail-ia0-f169.google.com ([209.85.210.169]:46940) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1TLOMX-0006fS-4A for emacs-devel@gnu.org; Mon, 08 Oct 2012 21:11:57 -0400 Original-Received: by mail-ia0-f169.google.com with SMTP id h37so542607iak.0 for ; Mon, 08 Oct 2012 18:11:56 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=haxney.org; s=google; h=mime-version:in-reply-to:references:from:date:message-id:subject:to :cc:content-type:content-transfer-encoding; bh=lO6jDmngDczJQZA9CB0KwoxDXkmELUFvnAqu0G9dBi4=; b=ffuM9/SSnKgruKVo12ctd/O5UC38PJDnscXlZuDEIb7XvadZg/VS+EWbSgYpF1cCWw 750VXJkpJs6seue3Mpv4jnk9unXfLIrg4UaQNWYcnSH57uXLtTJoX6PotyC61ebfyj4u +Wayc7xk4y3EtDuQjpASHXTh+ybKL1PA0QnoU= X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=20120113; h=mime-version:in-reply-to:references:from:date:message-id:subject:to :cc:content-type:content-transfer-encoding:x-gm-message-state; bh=lO6jDmngDczJQZA9CB0KwoxDXkmELUFvnAqu0G9dBi4=; b=lUFp04/ZPwFwr7ZhcBz2UIBnn4CShIbyhyTUu4IKvLxfqIj71THlaonImtc4MtBi4k +DAn/GWqs2J3qFiWCVk6Ii5SozH2VUTvvZD3eWTvY6ZaX6rmPMvwaOZIh6r9F0jYxnbV /As5+rL/yo0BA0ancs8WHvtYa74Hr4SENaV3WGUiqXj350QdlOL5s5cUHM3RrnlMzU/D tJZx3EhLE6Vxvq/WOkSDdpFZuU8mz9iyTiV+Hd2UCVl47ALl7LqI/CeFT/5iyGsuAYoC Ps904ygOcTARBCdI5Yq8YcPg/K0QlC6rLa1owPJ1rqkvj9tWCWa7rc5zTLJqJyGSALQG Ycdw== Original-Received: by 10.50.104.225 with SMTP id gh1mr147756igb.64.1349745116376; Mon, 08 Oct 2012 18:11:56 -0700 (PDT) Original-Received: by 10.64.101.197 with HTTP; Mon, 8 Oct 2012 18:11:34 -0700 (PDT) In-Reply-To: X-Gm-Message-State: ALoCoQmYhMM7/a65/96E34yfV8gsIQwaXrh7bhwmJmMcDdZdXFR4Wc+puhMCNefscIyHZd41otBi X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 209.85.210.169 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:154250 Archived-At: Stefan Monnier wrote: >> The CL info pages refer to them as slots, so that's what I figured I'd >> use. There could be a better name for a package defstruct, but "field" >> "property" and "attribute" are overdone :) > > Sure, use whatever suits you. > >> I agree that the slot name could definitely be improved. `name' does >> imply a string to me, but I think that it is good for the "primary key" >> of the alists to be a symbol. Something like `canonical-name' perhaps? >> `id' maybe? I'm not terribly attached to any particular slot name. > > `name' is no worse than the others, so just use that. > >> This was intended to be related to `define-package'; it turns the >> `define-package' call into a `package-desc' struct. > > I understand the motivation, but the use of a "package-" prefix is > more important, I think. > >> I haven't looked at lexical binding in earnest. Should I reference >> the non-prefixed form in the body of `define-package'? > > The symbols prefixed by "_" are not treated specially by the > compiler/evaluator. The use of _ only affects the warnings you might > get (where a `_foo' that is used or a `foo' that is not used will signal > a warning) and the way things are displayed in *Help* (where the > underscore is stripped, since whether or not an argument is used is an > implementation detail). I replaced most of the instances of `concat' with `format' which means that there is almost no use of `symbol-name' (since it is being done within `format'). I also further standardized the naming of arguments; NAME for the package name (as a symbol), SUMMARY for the one-line description, and a couple others. Everything uses the "package-*" prefix, and `define-package' has been removed entirely. The "foo-pkg.el" files are no longer `load'ed directly. Instead, they are read with `package-read-from-string' and the cdr is sent to `package-desc-from-define', which has the same signature as the old `package-define'. Version 3 includes a basic test suite which exercises package installing, both through lisp (`package-install-file') and through the menu. Both single- and multi-file packages are covered, as is reading from an "archive-contents" file. I haven't tested package deleting, obsoleting, or upgrading, but, aside from name changes, I haven't done much to disturb that part of the code. That would be the next big thing I'd want to tackle. Patch follows, with static version available here: https://github.com/downloads/haxney/emacs/package-defstruct3.diff Patch contents: diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 28d1662..602f6c8 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -169,6 +169,8 @@ ;;; Code: +(require 'cl-lib) + (require 'tabulated-list) (defgroup package nil @@ -244,11 +246,8 @@ Lower version numbers than this will probably be understood as well.") ;; We don't prime the cache since it tends to get out of date. (defvar package-archive-contents nil "Cache of the contents of the Emacs Lisp Package Archive. -This is an alist mapping package names (symbols) to package -descriptor vectors. These are like the vectors for `package-alist' -but have extra entries: one which is 'tar for tar packages and -'single for single-file packages, and one which is the name of -the archive from which it came.") +This is an alist mapping package names (symbols) to +`package-desc' structures.") (put 'package-archive-contents 'risky-local-variable t) (defcustom package-user-dir (locate-user-emacs-file "elpa") @@ -279,6 +278,50 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") +(cl-defstruct (package-desc + ;; Rename the default constructor from `make-package-desc'. + (:constructor package-desc-create) + ;; Has the same interface as the old `define-package', + ;; which is still used in the "foo-pkg.el" files. Extra + ;; options can be supported by adding additional keys. + (:constructor + package-desc-from-define + (name-string version-string &optional summary requirements + &key kind archive + &aux (name (intern name-string)) + (version (ignore-errors (version-to-list version-string))) + (reqs (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + requirements))))) + "Structure containing information about an individual package. + +Slots: + +`name' Name of the package, as a symbol. + +`version' Version of the package, as a version list. + +`summary' Short description of the package, typically taken from +the first line of the file. + +`reqs' Requirements of the package. A list of (PACKAGE +VERSION-LIST) naming the dependent package and the minimum +required version. + +`kind' The distribution format of the package. Currently, it is +either `single' or `tar'. + +`archive' The name of the archive (as a string) whence this +package came." + name + version + (summary "No description available.") + reqs + kind + archive) + ;; The value is precomputed in finder-inf.el, but don't load that ;; until it's needed (i.e. when `package-initialize' is called). (defvar package--builtins nil @@ -288,26 +331,13 @@ The actual value is initialized by loading the librar= y function `package-built-in-p'. Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL), where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package.") +name (a symbol) and DESC is a `package-desc' structure.") (put 'package--builtins 'risky-local-variable t) (defvar package-alist nil "Alist of all packages available for activation. Each element has the form (PKG . DESC), where PKG is a package -name (a symbol) and DESC is a vector that describes the package. - -The vector DESC has the form [VERSION-LIST REQS DOCSTRING]. - VERSION-LIST is a version list. - REQS is a list of packages required by the package, each - requirement having the form (NAME VL) where NAME is a string - and VL is a version list. - DOCSTRING is a brief description of the package. +name (a symbol) and DESC is a `package-desc' structure. This variable is set automatically by `package-load-descriptor', called via `package-initialize'. To change which packages are @@ -321,7 +351,10 @@ loaded and/or activated, customize `package-load-list'= .") (defvar package-obsolete-alist nil "Representation of obsolete packages. Like `package-alist', but maps package name to a second alist. -The inner alist is keyed by version.") +The inner alist is keyed by version. + +Each element of the list is (NAME . VERSION-ALIST), where each +entry in VERSION-ALIST is (VERSION-LIST . PACKAGE-DESC).") (put 'package-obsolete-alist 'risky-local-variable t) (defun package-version-join (vlist) @@ -359,17 +392,50 @@ E.g., if given \"quux-23.0\", will return \"quux\"" (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirna= me) (match-string 1 dirname))) -(defun package-load-descriptor (dir package) - "Load the description file in directory DIR for package PACKAGE. -Here, PACKAGE is a string of the form NAME-VERSION, where NAME is -the package name and VERSION is its version." - (let* ((pkg-dir (expand-file-name package dir)) +(defun package-load-descriptor (name version dir) + "Load the description file in directory DIR for package NAME. +NAME is the package name as a symbol and VERSION must be a +string." + (let* ((old-pkg (cdr-safe (assq name package-alist))) + (pkg-dir (expand-file-name (format "%s-%s" name version) dir)) (pkg-file (expand-file-name - (concat (package-strip-version package) "-pkg") - pkg-dir))) - (when (and (file-directory-p pkg-dir) - (file-exists-p (concat pkg-file ".el"))) - (load pkg-file nil t)))) + (format "%s-pkg.el" name) + pkg-dir)) + (pkg-def-contents (with-temp-buffer + (insert-file-literally pkg-file) + (buffer-string))) + (pkg-def-parsed (package-read-from-string pkg-def-contents)) + pkg-desc) + + (unless (eq (car pkg-def-parsed) 'define-package) + (error "No `define-package' sexp is present in `%s-pkg.el'" name)) + + (setq pkg-desc (apply #'package-desc-from-define + (append (cdr pkg-def-parsed) '(:kind tar)))) + (unless (equal (package-version-join (package-desc-version pkg-desc)) + version) + (error "Package has inconsistent versions")) + (unless (eq (package-desc-name pkg-desc) name) + (error "Package has inconsistent names")) + + (cond + ;; If there's no old package, just add this to `package-alist'. + ((null old-pkg) + (push (cons name pkg-desc) package-alist)) + ((version-list-< (package-desc-version old-pkg) + (version-to-list version)) + ;; Remove the old package and declare it obsolete. + (package-mark-obsolete old-pkg) + (cl-delete (package-desc-name old-pkg) package-alist :key 'car) + (push package-alist (cons name pkg-desc))) + ;; You can have two packages with the same version, e.g. one in + ;; the system package directory and one in your private + ;; directory. We just let the first one win. + ((not (version-list-=3D (package-desc-version old-pkg) + (version-to-list version))) + ;; The package is born obsolete. + (package-mark-obsolete pkg-desc))) + pkg-desc)) (defun package-load-all-descriptors () "Load descriptors for installed Emacs Lisp packages. @@ -385,17 +451,17 @@ updates `package-alist' and `package-obsolete-alist'.= " (when (file-directory-p dir) (dolist (subdir (directory-files dir)) (when (string-match regexp subdir) - (package-maybe-load-descriptor (match-string 1 subdir) + (package-maybe-load-descriptor (intern (match-string 1 subdir)) (match-string 2 subdir) dir))))))) (defun package-maybe-load-descriptor (name version dir) "Maybe load a specific package from directory DIR. -NAME and VERSION are the package's name and version strings. -This function checks `package-load-list', before actually loading -the package by calling `package-load-descriptor'." - (let ((force (assq (intern name) package-load-list)) - (subdir (concat name "-" version))) +NAME is the package name as a symbol and VERSION is the package's +version string. This function checks `package-load-list', before +actually loading the package by calling`package-load-descriptor'." + (let ((force (assq name package-load-list)) + (subdir (format "%s-%s" name version))) (and (file-directory-p (expand-file-name subdir dir)) ;; Check `package-load-list': (cond ((null force) @@ -410,28 +476,12 @@ the package by calling `package-load-descriptor'." (t (error "Invalid element in `package-load-list'"))) ;; Actually load the descriptor: - (package-load-descriptor dir subdir)))) - -(defsubst package-desc-vers (desc) - "Extract version from a package description vector." - (aref desc 0)) - -(defsubst package-desc-reqs (desc) - "Extract requirements from a package description vector." - (aref desc 1)) - -(defsubst package-desc-doc (desc) - "Extract doc string from a package description vector." - (aref desc 2)) - -(defsubst package-desc-kind (desc) - "Extract the kind of download from an archive package description vector= ." - (aref desc 3)) + (package-load-descriptor name version dir)))) (defun package--dir (name version) "Return the directory where a package is installed, or nil if none. -NAME and VERSION are both strings." - (let* ((subdir (concat name "-" version)) +NAME is the package name as a symbol and VERSION is a string." + (let* ((subdir (format "%s-%s" name version)) (dir-list (cons package-user-dir package-directory-list)) pkg-dir) (while dir-list @@ -442,9 +492,9 @@ NAME and VERSION are both strings." (setq dir-list (cdr dir-list))))) pkg-dir)) -(defun package-activate-1 (package pkg-vec) - (let* ((name (symbol-name package)) - (version-str (package-version-join (package-desc-vers pkg-vec))) +(defun package-activate-1 (pkg-desc) + (let* ((name (package-desc-name pkg-desc)) + (version-str (package-version-join (package-desc-version pkg-desc))) (pkg-dir (package--dir name version-str))) (unless pkg-dir (error "Internal error: unable to find directory for `%s-%s'" @@ -457,8 +507,8 @@ NAME and VERSION are both strings." (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. (push pkg-dir load-path) - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (push package package-activated-list) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) + (push name package-activated-list) ;; Don't return nil. t)) @@ -471,98 +521,58 @@ specifying the minimum acceptable version." (version-list-<=3D min-version (version-to-list emacs-version)) (let ((elt (assq package package--builtins))) (and elt (version-list-<=3D min-version - (package-desc-vers (cdr elt))))))) + (package-desc-version (cdr elt))))))) ;; This function goes ahead and activates a newer version of a package ;; if an older one was already activated. This is not ideal; we'd at ;; least need to check to see if the package has actually been loaded, ;; and not merely activated. -(defun package-activate (package min-version) - "Activate package PACKAGE, of version MIN-VERSION or newer. +(defun package-activate (name min-version) + "Activate package NAME, of version MIN-VERSION or newer. MIN-VERSION should be a version list. -If PACKAGE has any dependencies, recursively activate them. +If NAME has any dependencies, recursively activate them. Return nil if the package could not be activated." - (let ((pkg-vec (cdr (assq package package-alist))) + (let ((pkg-desc (cdr (assq name package-alist))) available-version found) ;; Check if PACKAGE is available in `package-alist'. - (when pkg-vec - (setq available-version (package-desc-vers pkg-vec) + (when pkg-desc + (setq available-version (package-desc-version pkg-desc) found (version-list-<=3D min-version available-version))) (cond ;; If no such package is found, maybe it's built-in. ((null found) - (package-built-in-p package min-version)) + (package-built-in-p name min-version)) ;; If the package is already activated, just return t. - ((memq package package-activated-list) + ((memq name package-activated-list) t) ;; Otherwise, proceed with activation. (t (let ((fail (catch 'dep-failure ;; Activate its dependencies recursively. - (dolist (req (package-desc-reqs pkg-vec)) + (dolist (req (package-desc-reqs pkg-desc)) (unless (package-activate (car req) (cadr req)) (throw 'dep-failure req)))))) (if fail (warn "Unable to activate package `%s'. Required package `%s-%s' is unavailable" - package (car fail) (package-version-join (cadr fail))) + name (car fail) (package-version-join (cadr fail))) ;; If all goes well, activate the package itself. - (package-activate-1 package pkg-vec))))))) + (package-activate-1 pkg-desc))))))) -(defun package-mark-obsolete (package pkg-vec) - "Put package on the obsolete list, if not already there." - (let ((elt (assq package package-obsolete-alist))) - (if elt - ;; If this obsolete version does not exist in the list, update - ;; it the list. - (unless (assoc (package-desc-vers pkg-vec) (cdr elt)) - (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) - (cdr elt)))) +(defun package-mark-obsolete (pkg-desc) + "Put PKG-DESC on the obsolete list, if not already there." + (let* ((name (package-desc-name pkg-desc)) + (existing-elt (assq name package-obsolete-alist)) + (pkg-version (package-desc-version pkg-desc))) + (if existing-elt + ;; Add this obsolete version to the list if it is not already there. + (unless (assoc pkg-version (cdr existing-elt)) + (setcdr existing-elt (cons (cons pkg-version pkg-desc) + (cdr existing-elt)))) ;; Make a new association. - (push (cons package (list (cons (package-desc-vers pkg-vec) - pkg-vec))) + (push (cons name (list (cons pkg-version pkg-desc))) package-obsolete-alist)))) -(defun define-package (name-string version-string - &optional docstring requirements - &rest _extra-properties) - "Define a new package. -NAME-STRING is the name of the package, as a string. -VERSION-STRING is the version of the package, as a string. -DOCSTRING is a short description of the package, a string. -REQUIREMENTS is a list of dependencies on other packages. - Each requirement is of the form (OTHER-PACKAGE OTHER-VERSION), - where OTHER-VERSION is a string. - -EXTRA-PROPERTIES is currently unused." - (let* ((name (intern name-string)) - (version (version-to-list version-string)) - (new-pkg-desc - (cons name - (vector version - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requirements) - docstring))) - (old-pkg (assq name package-alist))) - (cond - ;; If there's no old package, just add this to `package-alist'. - ((null old-pkg) - (push new-pkg-desc package-alist)) - ((version-list-< (package-desc-vers (cdr old-pkg)) version) - ;; Remove the old package and declare it obsolete. - (package-mark-obsolete name (cdr old-pkg)) - (setq package-alist (cons new-pkg-desc - (delq old-pkg package-alist)))) - ;; You can have two packages with the same version, e.g. one in - ;; the system package directory and one in your private - ;; directory. We just let the first one win. - ((not (version-list-=3D (package-desc-vers (cdr old-pkg)) version)) - ;; The package is born obsolete. - (package-mark-obsolete name (cdr new-pkg-desc)))))) - ;; From Emacs 22. (defun package-autoload-ensure-default-file (file) "Make sure that the autoload file FILE exists and if not create it." @@ -584,13 +594,13 @@ EXTRA-PROPERTIES is currently unused." (defun package-generate-autoloads (name pkg-dir) (require 'autoload) ;Load before we let-bind generated-autoload-= file! - (let* ((auto-name (concat name "-autoloads.el")) - ;;(ignore-name (concat name "-pkg.el")) + (let* ((auto-name (format "%s-autoloads.el" name)) (generated-autoload-file (expand-file-name auto-name pkg-dir)) (version-control 'never)) (unless (fboundp 'autoload-ensure-default-file) (package-autoload-ensure-default-file generated-autoload-file)) - (update-directory-autoloads pkg-dir))) + (update-directory-autoloads pkg-dir) + (kill-buffer (get-buffer auto-name)))) (defvar tar-parse-info) (declare-function tar-untar-buffer "tar-mode" ()) @@ -608,9 +618,10 @@ untar into a directory named DIR; otherwise, signal an error." (error "Package does not untar cleanly into directory %s/" dir)))) (tar-untar-buffer)) -(defun package-unpack (package version) - (let* ((name (symbol-name package)) - (dirname (concat name "-" version)) +(defun package-unpack (name version) + "Unpack a tar package. +VERSION must be a string. NAME is the package name as a symbol." + (let* ((dirname (format "%s-%s" name version)) (pkg-dir (expand-file-name dirname package-user-dir))) (make-directory package-user-dir t) ;; FIXME: should we delete PKG-DIR if it exists? @@ -620,30 +631,33 @@ untar into a directory named DIR; otherwise, signal an error." (defun package--make-autoloads-and-compile (name pkg-dir) "Generate autoloads and do byte-compilation for package named NAME. -PKG-DIR is the name of the package directory." +NAME is the name of the file to compile as a symbol and PKG-DIR +is the name of the package directory." (package-generate-autoloads name pkg-dir) (let ((load-path (cons pkg-dir load-path))) ;; We must load the autoloads file before byte compiling, in ;; case there are magic cookies to set up non-trivial paths. - (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) + (load (expand-file-name (format "%s-autoloads" name) pkg-dir) nil t) (byte-recompile-directory pkg-dir 0 t))) (defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) (write-region (point-min) (point-max) file-name))) -(defun package-unpack-single (file-name version desc requires) - "Install the contents of the current buffer as a package." +(defun package-unpack-single (name version desc requires) + "Install the contents of the current buffer as a package. +NAME is the name of the package as a symbol; VERSION and DESC +must be strings." ;; Special case "package". - (if (string=3D file-name "package") + (if (eq name 'package) (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir)) - (let* ((pkg-dir (expand-file-name (concat file-name "-" + (expand-file-name (format "%s.el" name) package-user-dir)) + (let* ((pkg-dir (expand-file-name (format "%s-%s" name (package-version-join (version-to-list version))) - package-user-dir)) - (el-file (expand-file-name (concat file-name ".el") pkg-dir)) - (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) + package-user-dir)) + (el-file (expand-file-name (format "%s.el" name) pkg-dir)) + (pkg-file (expand-file-name (format "%s-pkg.el" name) pkg-dir))) (make-directory pkg-dir t) (package--write-file-no-coding el-file) (let ((print-level nil) @@ -652,21 +666,20 @@ PKG-DIR is the name of the package directory." (concat (prin1-to-string (list 'define-package - file-name + (symbol-name name) version desc - (list 'quote - ;; Turn version lists into string form. - (mapcar - (lambda (elt) - (list (car elt) - (package-version-join (cadr elt)))) - requires)))) + ;; Turn version lists into string form. + (mapcar + (lambda (elt) + (list (car elt) + (package-version-join (cadr elt)))) + requires))) "\n") nil pkg-file nil nil nil 'excl)) - (package--make-autoloads-and-compile file-name pkg-dir)))) + (package--make-autoloads-and-compile name pkg-dir)))) (defmacro package--with-work-buffer (location file &rest body) "Run BODY in a buffer containing the contents of FILE at LOCATION. @@ -714,26 +727,26 @@ It will move point to somewhere in the headers." (defun package-download-single (name version desc requires) "Download and install a single-file package." (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".el"))) + (file (format "%s-%s.el" name version))) (package--with-work-buffer location file - (package-unpack-single (symbol-name name) version desc requires)))) + (package-unpack-single name version desc requires)))) (defun package-download-tar (name version) "Download and install a tar package." (let ((location (package-archive-base name)) - (file (concat (symbol-name name) "-" version ".tar"))) + (file (format "%s-%s.tar" name version))) (package--with-work-buffer location file - (package-unpack name version)))) + (package-unpack name version)))) -(defun package-installed-p (package &optional min-version) - "Return true if PACKAGE, of MIN-VERSION or newer, is installed. -MIN-VERSION should be a version list." - (let ((pkg-desc (assq package package-alist))) +(defun package-installed-p (name &optional min-version) + "Return true if NAME, of MIN-VERSION or newer, is installed. +NAME must be a symbol and MIN-VERSION must be a version list." + (let ((pkg-desc (assq name package-alist))) (if pkg-desc (version-list-<=3D min-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version (cdr pkg-desc))) ;; Also check built-in packages. - (package-built-in-p package min-version)))) + (package-built-in-p name min-version)))) (defun package-compute-transaction (package-list requirements) "Return a list of packages to be installed, including PACKAGE-LIST. @@ -754,7 +767,7 @@ not included in this list." (unless (package-installed-p next-pkg next-version) ;; A package is required, but not installed. It might also be ;; blocked via `package-load-list'. - (let ((pkg-desc (assq next-pkg package-archive-contents)) + (let ((pkg-desc (cdr (assq next-pkg package-archive-contents))) hold) (when (setq hold (assq next-pkg package-load-list)) (setq hold (cadr hold)) @@ -774,18 +787,18 @@ but version %s required" (symbol-name next-pkg) (package-version-join next-version))) (unless (version-list-<=3D next-version - (package-desc-vers (cdr pkg-desc))) + (package-desc-version pkg-desc)) (error "Need package `%s-%s', but only %s is available" (symbol-name next-pkg) (package-version-join next-version) - (package-version-join (package-desc-vers (cdr pkg-desc))))) + (package-version-join (package-desc-version pkg-desc)))) ;; Only add to the transaction if we don't already have it. (unless (memq next-pkg package-list) (push next-pkg package-list)) (setq package-list (package-compute-transaction package-list (package-desc-reqs - (cdr pkg-desc)))))))) + pkg-desc))))))) package-list) (defun package-read-from-string (str) @@ -828,8 +841,6 @@ If successful, set `package-archive-contents'." "Re-read archive contents for ARCHIVE. If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." - ;; Version 1 of 'archive-contents' is identical to our internal - ;; representation. (let* ((dir (concat "archives/" archive)) (contents-file (concat dir "/archive-contents")) contents) @@ -839,16 +850,24 @@ If the archive version is too new, signal an error." (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. -Also, add the originating archive to the end of the package vector." - (let* ((name (car package)) - (version (package-desc-vers (cdr package))) - (entry (cons name - (vconcat (cdr package) (vector archive)))) - (existing-package (assq name package-archive-contents))) +Also, add the originating archive to the `package-desc' structure." + (let* ((name (car package)) + (pkg-desc + ;; These are the offsets into the "archive-contents" + ;; array. They are formatted this way for historical reasons + ;; which is why they are magic numbers here. + (package-desc-create :name name + :version (aref (cdr package) 0) + :reqs (aref (cdr package) 1) + :summary (aref (cdr package) 2) + :kind (aref (cdr package) 3) + :archive archive)) + (entry (cons name pkg-desc)) + (existing-package (assq name package-archive-contents))) (cond ((not existing-package) (add-to-list 'package-archive-contents entry)) - ((version-list-< (package-desc-vers (cdr existing-package)) - version) + ((version-list-< (package-desc-version (cdr existing-package)) + (package-desc-version pkg-desc)) ;; Replace the entry with this one. (setq package-archive-contents (cons entry @@ -867,21 +886,21 @@ using `package-compute-transaction'." ;; `package-load-list', download the held version. (hold (cadr (assq elt package-load-list))) (v-string (or (and (stringp hold) hold) - (package-version-join (package-desc-vers desc)))) + (package-version-join (package-desc-version desc)))) (kind (package-desc-kind desc))) (cond ((eq kind 'tar) (package-download-tar elt v-string)) ((eq kind 'single) (package-download-single elt v-string - (package-desc-doc desc) + (package-desc-summary desc) (package-desc-reqs desc))) (t (error "Unknown package kind: %s" (symbol-name kind)))) ;; If package A depends on package B, then A may `require' B ;; during byte compilation. So we need to activate B before ;; unpacking A. - (package-maybe-load-descriptor (symbol-name elt) v-string + (package-maybe-load-descriptor elt v-string package-user-dir) (package-activate elt (version-to-list v-string))))) @@ -928,17 +947,7 @@ Otherwise return nil." (error nil)))) (defun package-buffer-info () - "Return a vector describing the package in the current buffer. -The vector has the form - - [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] - -FILENAME is the file name, a string, sans the \".el\" extension. -REQUIRES is a list of requirements, each requirement having the - form (NAME VER); NAME is a string and VER is a version list. -DESCRIPTION is the package description, a string. -VERSION is the version, a string. -COMMENTARY is the commentary section, a string, or nil if none. + "Return a `package-desc' for the package in the current buffer. If the buffer does not contain a conforming package, signal an error. If there is a package, narrow the buffer to the file's @@ -947,9 +956,9 @@ boundaries." (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[ \t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t) (error "Packages lacks a file header")) (let ((file-name (match-string-no-properties 1)) - (desc (match-string-no-properties 2)) + (summary (match-string-no-properties 2)) (start (line-beginning-position))) - (unless (search-forward (concat ";;; " file-name ".el ends here")) + (unless (search-forward (format ";;; %s.el ends here" file-name)) (error "Package lacks a terminating comment")) ;; Try to include a trailing newline. (forward-line) @@ -968,19 +977,17 @@ boundaries." (unless pkg-version (error "Package lacks a \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (vector file-name requires desc pkg-version commentary)))) + + (package-desc-create :name (intern file-name) + :version (version-to-list pkg-version) + :summary summary + :reqs requires + :kind 'single)))) (defun package-tar-file-info (file) - "Find package information for a tar file. -FILE is the name of the tar file to examine. -The return result is a vector like `package-buffer-info'." + "Build a `package-desc' from the contents of a tar file. +Looks for a \"foo-pkg.el\" file in the tar file which must +contain a package definition." (let ((default-directory (file-name-directory file)) (file (file-name-nondirectory file))) (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'") @@ -991,68 +998,52 @@ The return result is a vector like `package-buffer-in= fo'." ;; Extract the package descriptor. (pkg-def-contents (shell-command-to-string ;; Requires GNU tar. - (concat "tar -xOf " file " " - - pkg-name "-" pkg-version "/" - pkg-name "-pkg.el"))) + (format "tar -xOf %s %s-%s/%s-pkg.el" + file pkg-name pkg-version pkg-name))) (pkg-def-parsed (package-read-from-string pkg-def-contents))) (unless (eq (car pkg-def-parsed) 'define-package) (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) - (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - (readme (shell-command-to-string - ;; Requires GNU tar. - (concat "tar -xOf " file " " - pkg-name "-" pkg-version "/README")))) - (unless (equal pkg-version version-string) + + (let ((pkg-desc (apply #'package-desc-from-define + (append (cdr pkg-def-parsed) '(:kind tar))))) + (unless (equal (package-version-join (package-desc-version pkg-desc)) + pkg-version) (error "Package has inconsistent versions")) - (unless (equal pkg-name name-str) + (unless (equal (symbol-name (package-desc-name pkg-desc)) + pkg-name) (error "Package has inconsistent names")) - ;; Kind of a hack. - (if (string-match ": Not found in archive" readme) - (setq readme nil)) - ;; Turn string version numbers into list form. - (if (eq (car requires) 'quote) - (setq requires (car (cdr requires)))) - (setq requires - (mapcar (lambda (elt) - (list (car elt) - (version-to-list (cadr elt)))) - requires)) - (vector pkg-name requires docstring version-string readme))))) + + pkg-desc)))) ;;;###autoload -(defun package-install-from-buffer (pkg-info type) +(defun package-install-from-buffer (pkg-desc) "Install a package from the current buffer. When called interactively, the current buffer is assumed to be a single .el file that follows the packaging guidelines; see info node `(elisp)Packaging'. -When called from Lisp, PKG-INFO is a vector describing the -information, of the type returned by `package-buffer-info'; and -TYPE is the package type (either `single' or `tar')." - (interactive (list (package-buffer-info) 'single)) +When called from Lisp, PKG-DESC is a `package-desc' structure." + (interactive (list (package-buffer-info))) (save-excursion (save-restriction - (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) - (desc (if (string=3D (aref pkg-info 2) "") - "No description available." - (aref pkg-info 2))) - (pkg-version (aref pkg-info 3))) + (let* ((name (package-desc-name pkg-desc)) + (requires (package-desc-reqs pkg-desc)) + (pkg-version (package-desc-version pkg-desc)) + (kind (package-desc-kind pkg-desc))) ;; Download and install the dependencies. (let ((transaction (package-compute-transaction nil requires))) (package-download-transaction transaction)) ;; Install the package itself. (cond - ((eq type 'single) - (package-unpack-single file-name pkg-version desc requires)) - ((eq type 'tar) - (package-unpack (intern file-name) pkg-version)) + ((eq kind 'single) + (package-unpack-single name + (package-version-join pkg-version) + (package-desc-summary pkg-desc) + requires)) + ((eq kind 'tar) + (package-unpack name (package-version-join pkg-version))) (t - (error "Unknown type: %s" (symbol-name type)))) + (error "Unknown package type: %s" kind))) ;; Try to activate it. (package-initialize))))) @@ -1065,9 +1056,9 @@ The file can either be a tar file or an Emacs Lisp fi= le." (insert-file-contents-literally file) (cond ((string-match "\\.el$" file) - (package-install-from-buffer (package-buffer-info) 'single)) + (package-install-from-buffer (package-buffer-info))) ((string-match "\\.tar$" file) - (package-install-from-buffer (package-tar-file-info file) 'tar)) + (package-install-from-buffer (package-tar-file-info file))) (t (error "Unrecognized extension `%s'" (file-name-extension file))))= )) (defun package-delete (name version) @@ -1083,9 +1074,10 @@ The file can either be a tar file or an Emacs Lisp f= ile." name version)))) (defun package-archive-base (name) - "Return the archive containing the package NAME." - (let ((desc (cdr (assq (intern-soft name) package-archive-contents)))) - (cdr (assoc (aref desc (- (length desc) 1)) package-archives)))) + "Return the archive containing the package NAME. +NAME must be a symbol." + (let ((desc (cdr (assq name package-archive-contents)))) + (cdr (assoc (package-desc-archive desc) package-archives)))) (defun package--download-one-archive (archive file) "Retrieve an archive file FILE from ARCHIVE, and cache it. @@ -1130,7 +1122,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (package-read-all-archive-contents) (unless no-activate (dolist (elt package-alist) - (package-activate (car elt) (package-desc-vers (cdr elt))))) + (package-activate (car elt) (package-desc-version (cdr elt))))) (setq package--initialized t)) =0C @@ -1177,21 +1169,21 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (cond ;; Loaded packages are in `package-alist'. ((setq desc (cdr (assq package package-alist))) - (setq version (package-version-join (package-desc-vers desc))) + (setq version (package-version-join (package-desc-version desc))) (if (setq pkg-dir (package--dir package-name version)) (insert "an installed package.\n\n") ;; This normally does not happen. (insert "a deleted package.\n\n"))) ;; Available packages are in `package-archive-contents'. ((setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc)) + (setq version (package-version-join (package-desc-version desc)) installable t) (if built-in (insert "a built-in package.\n\n") (insert "an uninstalled package.\n\n"))) (built-in (setq desc (cdr built-in) - version (package-version-join (package-desc-vers desc))) + version (package-version-join (package-desc-version desc))) (insert "a built-in package.\n\n")) (t (insert "an orphan package.\n\n"))) @@ -1240,7 +1232,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (dolist (req reqs) (setq name (car req) vers (cadr req) - text (format "%s-%s" (symbol-name name) + text (format "%s-%s" name (package-version-join vers))) (cond (first (setq first nil)) ((>=3D (+ 2 (current-column) (length text)) @@ -1250,11 +1242,11 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (help-insert-xref-button text 'help-package name)) (insert "\n"))) (insert " " (propertize "Summary" 'font-lock-face 'bold) - ": " (if desc (package-desc-doc desc)) "\n\n") + ": " (if desc (package-desc-summary desc)) "\n\n") (if built-in ;; For built-in packages, insert the commentary. - (let ((fn (locate-file (concat package-name ".el") load-path + (let ((fn (locate-file (format "%s.el" package-name) load-path load-file-rep-suffixes)) (opoint (point))) (insert (or (lm-commentary fn) "")) @@ -1264,14 +1256,14 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (replace-match "")) (while (re-search-forward "^\\(;+ ?\\)" nil t) (replace-match "")))) - (let ((readme (expand-file-name (concat package-name "-readme.txt") + (let ((readme (expand-file-name (format "%s-readme.txt" package-name= ) package-user-dir)) readme-string) ;; For elpa packages, try downloading the commentary. If that ;; fails, try an existing readme file in `package-user-dir'. (cond ((condition-case nil (package--with-work-buffer (package-archive-base package) - (concat package-name "-readme.txt") + (format "%s-readme.txt" package-name) (setq buffer-file-name (expand-file-name readme package-user-dir)) (let ((version-control 'never)) @@ -1376,29 +1368,38 @@ Letters do not insert themselves; instead, they are commands. (setq tabulated-list-sort-key (cons "Status" nil)) (tabulated-list-init-header)) -(defmacro package--push (package desc status listname) +(defmacro package--push (pkg status listname) "Convenience macro for `package-menu--generate'. -If the alist stored in the symbol LISTNAME lacks an entry for a -package PACKAGE with descriptor DESC, add one. The alist is -keyed with cons cells (PACKAGE . VERSION-LIST), where PACKAGE is -a symbol and VERSION-LIST is a version list." - `(let* ((version (package-desc-vers ,desc)) - (key (cons ,package version))) - (unless (assoc key ,listname) - (push (list key ,status (package-desc-doc ,desc)) ,listname)))) +If the alist stored in the symbol LISTNAME lacks an entry for +`package-desc' PKG, add one. The alist is keyed with cons +cells (NAME . VERSION-LIST), where NAME is a symbol and +VERSION-LIST is a version list. The values of LISTNAME are lists +of STATUS and the package summary. + +LISTNAME looks like this: + +\( ((foo . (1 2 3)) + (status summary)) ... )" + `(cl-pushnew (list (cons (package-desc-name ,pkg) + (package-desc-version ,pkg)) + ,status + (package-desc-summary ,pkg)) + ,listname + :key 'car + :test 'equal)) (defun package-menu--generate (remember-pos packages) "Populate the Package Menu. If REMEMBER-POS is non-nil, keep point on the same entry. PACKAGES should be t, which means to display all known packages, or a list of package names (symbols) to display." - ;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION). - (let (info-list name) + ;; Construct list of ((NAME . VERSION-LIST) STATUS DESCRIPTION) + (let (info-list name builtin) ;; Installed packages: (dolist (elt package-alist) (setq name (car elt)) (when (or (eq packages t) (memq name packages)) - (package--push name (cdr elt) + (package--push (cdr elt) (if (stringp (cadr (assq name package-load-list))) "held" "installed") info-list))) @@ -1408,14 +1409,14 @@ or a list of package names (symbols) to display." (setq name (car elt)) (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. (or (eq packages t) (memq name packages))) - (package--push name (cdr elt) "built-in" info-list))) + (package--push (cdr elt) "built-in" info-list))) ;; Available and disabled packages: (dolist (elt package-archive-contents) (setq name (car elt)) (when (or (eq packages t) (memq name packages)) (let ((hold (assq name package-load-list))) - (package--push name (cdr elt) + (package--push (cdr elt) (cond ((and hold (null (cadr hold))) "disabled") ((memq name package-menu--new-package-list) "new") @@ -1426,21 +1427,21 @@ or a list of package names (symbols) to display." (dolist (elt package-obsolete-alist) (dolist (inner-elt (cdr elt)) (when (or (eq packages t) (memq (car elt) packages)) - (package--push (car elt) (cdr inner-elt) "obsolete" info-list)))) + (package--push (cdr inner-elt) "obsolete" info-list)))) ;; Print the result. (setq tabulated-list-entries (mapcar 'package-menu--print-info info-li= st)) (tabulated-list-print remember-pos))) -(defun package-menu--print-info (pkg) +(defun package-menu--print-info (entry) "Return a package entry suitable for `tabulated-list-entries'. -PKG has the form ((PACKAGE . VERSION) STATUS DOC). -Return (KEY [NAME VERSION STATUS DOC]), where KEY is the +ENTRY has the form ((NAME . VERSION-LIST) STATUS SUMMARY). +Return (KEY [NAME VERSION-STRING STATUS SUMMARY]), where KEY is the identifier (NAME . VERSION-LIST)." - (let* ((package (caar pkg)) - (version (cdr (car pkg))) - (status (nth 1 pkg)) - (doc (or (nth 2 pkg) "")) + (let* ((name (caar entry)) + (version (cdar entry)) + (status (nth 1 entry)) + (summary (or (nth 2 entry) "")) (face (cond ((string=3D status "built-in") 'font-lock-builtin-face) ((string=3D status "available") 'default) @@ -1449,16 +1450,16 @@ identifier (NAME . VERSION-LIST)." ((string=3D status "disabled") 'font-lock-warning-face) ((string=3D status "installed") 'font-lock-comment-face) (t 'font-lock-warning-face)))) ; obsolete. - (list (cons package version) - (vector (list (symbol-name package) + (list (cons name version) + (vector (list (symbol-name name) 'face 'link 'follow-link t - 'package-symbol package + 'package-symbol name 'action 'package-menu-describe-package) (propertize (package-version-join version) 'font-lock-face face) (propertize status 'font-lock-face face) - (propertize doc 'font-lock-face face))))) + (propertize summary 'font-lock-face face))))) (defun package-menu-refresh () "Download the Emacs Lisp package archive. @@ -1534,7 +1535,7 @@ If optional arg BUTTON is non-nil, describe its associated package." (let (installed available upgrades) ;; Build list of installed/available packages in this buffer. (dolist (entry tabulated-list-entries) - ;; ENTRY is ((NAME . VERSION) [NAME VERSION STATUS DOC]) + ;; ENTRY is ((NAME . VERSION-LIST) [NAME VERSION-STRING STATUS SUMMA= RY]) (let ((pkg (car entry)) (status (aref (cadr entry) 2))) (cond ((equal status "installed") @@ -1617,7 +1618,7 @@ packages marked for deletion are removed." (format "Delete these %d packages (%s)? " (length delete-list) (mapconcat (lambda (elt) - (concat (car elt) "-" (cdr elt))) + (format "%s-%s" (car elt) (cdr elt))) delete-list ", ")))) (dolist (elt delete-list) @@ -1702,15 +1703,16 @@ The list is displayed in a buffer named `*Packages*= '." (package-menu--generate nil t)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. - (switch-to-buffer buf)) + (switch-to-buffer buf) - (let ((upgrades (package-menu--find-upgrades))) - (if upgrades - (message "%d package%s can be upgraded; type `%s' to mark %s for upgrad= ing." - (length upgrades) - (if (=3D (length upgrades) 1) "" "s") - (substitute-command-keys "\\[package-menu-mark-upgrades]") - (if (=3D (length upgrades) 1) "it" "them")))))) + (let ((upgrades (package-menu--find-upgrades))) + (if upgrades + (message "%d package%s can be upgraded; type `%s' to mark %s for upgrading." + (length upgrades) + (if (=3D (length upgrades) 1) "" "s") + (substitute-command-keys "\\[package-menu-mark-upgrades]") + (if (=3D (length upgrades) 1) "it" "them")))) + buf))) ;;;###autoload (defalias 'package-list-packages 'list-packages) diff --git a/lisp/finder.el b/lisp/finder.el index 6ccb4bf..5010c8b 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -205,12 +205,16 @@ from; the default is `load-path'." (setq version (ignore-errors (version-to-list version))) (setq entry (assq package package--builtins)) (cond ((null entry) - (push (cons package (vector version nil summary)) + (push (cons package (make-package-desc + :name package + :version version + :summary summary + :kind 'builtin)) package--builtins)) ((eq base-name package) (setq desc (cdr entry)) - (aset desc 0 version) - (aset desc 2 summary))) + (setf (package-desc-version desc) version + (package-desc-summary desc) summary))) (dolist (kw keywords) (puthash kw (cons package diff --git a/test/automated/Makefile.in b/test/automated/Makefile.in index 5f92e21..a6323df 100644 --- a/test/automated/Makefile.in +++ b/test/automated/Makefile.in @@ -50,7 +50,7 @@ emacs =3D EMACSLOADPATH=3D$(lispsrc):$(test) LC_ALL=3DC $(EMACS) $(EMACSOPT) # Common command to find subdirectories setwins=3Dsubdirs=3D`find . -type d -print`; \ for file in $$subdirs; do \ - case $$file in */.* | */.*/* | */=3D* ) ;; \ + case $$file in */.* | */.*/* | */=3D* | ./data* ) ;; \ *) wins=3D"$$wins $$file" ;; \ esac; \ done diff --git a/test/automated/data/package/archive-contents b/test/automated/data/package/archive-contents new file mode 100644 index 0000000..64826ea --- /dev/null +++ b/test/automated/data/package/archive-contents @@ -0,0 +1,7 @@ +(1 + (simple-single . + [(1 3) + nil "A single-file package with no dependencies" single]) + (multi-file . + [(0 2 3) + nil "Example of a multi-file tar package" tar])) diff --git a/test/automated/data/package/multi-file-0.2.3/README b/test/automated/data/package/multi-file-0.2.3/README new file mode 100644 index 0000000..affd2e9 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/README @@ -0,0 +1 @@ +This is a bare-bones readme file for the multi-file package. diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el b/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el new file mode 100644 index 0000000..64bf756 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file-pkg.el @@ -0,0 +1 @@ +(define-package "multi-file" "0.2.3" "Example of a multi-file tar package"= nil) diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el b/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el new file mode 100644 index 0000000..e14a6a9 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file-sub.el @@ -0,0 +1,39 @@ +;;; multi-file-sub.el --- A dependent file within a package. + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Jane Smith +;; Keywords: lisp, tools +;; Package: multi-file +;; Version: 0.2.3 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; The main multi-file elisp source depends on this. + +;;; Code: + +(defun multi-file-frobnicate (count) + "Frobnicate the current buffer COUNT times." + (interactive "p") + (dotimes (frobs count) + (insert "frobnicated " frobs "!\n"))) + +(provide 'multi-file-sub) + +;;; multi-file-sub.el ends here diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file.el b/test/automated/data/package/multi-file-0.2.3/multi-file.el new file mode 100644 index 0000000..5fed7d8 --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file.el @@ -0,0 +1,66 @@ +;;; multi-file.el --- Example of a multi-file tar package + +;; Copyright (C) 2012 Free Software Foundation, Inc. + +;; Author: Jane Smith +;; Keywords: lisp, tools +;; Package: multi-file +;; Version: 0.2.3 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; This is the main file of the "multi-file" package. + +;;; Code: + +(require 'multi-file-sub) + +(defgroup multi-file nil + "Multi-file example" + :group 'development) + +;;;###autoload +(defcustom multi-file-custom-var nil + "An example autoloaded custom variable" + :type 'boolean + :group 'multi-file) + +(defvar multi-file-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-l") 'multi-file-frobnicate) + map) + "Keymap for `multi-file-mode'") + + + +;;;###autoload +(define-derived-mode multi-file-mode text-mode "Multi" + "Major mode which does nothing but test things. + +The keys are: +\\{multi-file-mode-map}" + :group 'multi-file + (turn-off-auto-fill) + (set (make-local-variable 'comment-start) ";") + (setq case-fold-search nil)) + +(add-to-list 'auto-mode-alist '("\\.multi\\'" . multi-file-mode)) + +(provide 'multi-file) + +;;; multi-file.el ends here diff --git a/test/automated/data/package/multi-file-0.2.3/multi-file.texi b/test/automated/data/package/multi-file-0.2.3/multi-file.texi new file mode 100644 index 0000000..be7568b --- /dev/null +++ b/test/automated/data/package/multi-file-0.2.3/multi-file.texi @@ -0,0 +1,68 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename multi-file.info +@settitle Multi-file Example Manual 0.2.3 +@c %**end of header + +@copying +This is a short example of a complete Texinfo file. + +Copyright @copyright{} 2012 Jane Smith +@end copying + +@dircategory Emacs +@direntry +* Multi-file: (multi-file). Example of a multi-file tar package +@end direntry + +@titlepage +@title Multi-file Example Manual +@subtitle Example of a multi-file tar package +@page +@vskip 0pt plus 1filll +@insertcopying +@end titlepage + +@c Output the table of the contents at the beginning. +@contents + +@ifnottex +@node Top +@top Multi-file + +@insertcopying +@end ifnottex + +@menu +* First Chapter:: The first chapter is the only chapter in this sample. +* Index:: Complete index. +@end menu + + +@node First Chapter +@chapter First Chapter + +@cindex chapter, first + +This is the first chapter. +@cindex index entry, another + +Here is a numbered list. + +@enumerate +@item +This is the first item. + +@item +This is the second item. +@end enumerate + + +@node Index +@unnumbered Index + +@printindex cp + +@bye + +@c multi-file.texi ends here diff --git a/test/automated/data/package/simple-single-1.3.el b/test/automated/data/package/simple-single-1.3.el new file mode 100644 index 0000000..a617841 --- /dev/null +++ b/test/automated/data/package/simple-single-1.3.el @@ -0,0 +1,32 @@ +;;; simple-single.el --- A single-file package with no dependencies + +;; Author: J. R. Hacker +;; Version: 1.3 +;; Keywords: frobnicate + +;;; Commentary: + +;; This package provides a minor mode to frobnicate and/or bifurcate +;; any flanges you desire. To activate it, type "C-M-r M-3 butterfly" +;; and all your dreams will come true. + +;;; Code: + +(defgroup simple-single nil "Simply a file" + :group 'lisp) + +(defcustom simple-single-super-sunday t + "How great is this?" + :type 'boolean + :group 'simple-single) + +(defvar simple-single-sudo-sandwich nil + "Make a sandwich?") + +;;;###autoload +(define-minor-mode simple-single-mode + "It does good things to stuff") + +(provide 'simple-single) + +;;; simple-single.el ends here diff --git a/test/automated/package-test.el b/test/automated/package-test.e= l new file mode 100644 index 0000000..85edbe8 --- /dev/null +++ b/test/automated/package-test.el @@ -0,0 +1,261 @@ +;;; package-test.el --- Tests for the Emacs package system + +;; Author: Daniel Hackney +;; Version: 1.0 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Run this from a separate Emacs instance from your main one as it +;; messes with the installed packages. In fact, you should probably +;; back up your `package-user-dir' just in case! + +;; Run this in a clean Emacs session using: +;; +;; $ emacs -Q --batch -L . -l package-test.el -l ert -f ert-run-tests-batch-and-exit + +;;; Code: + +(require 'package) +(require 'ert) +(require 'cl-lib) + +(defvar package-test-original-user-dir package-user-dir + "Save the old value of `package-user-dir' to be restored later.") + +(defvar package-test-user-dir (make-temp-name + (concat temporary-file-directory "pkg-test-user-dir-")) + "Directory to use for installing packages during testing.") + +(setq package-user-dir package-test-user-dir) + +(defvar simple-single-desc [cl-struct-package-desc simple-single (1 3) + "A single-file package with no dependencies" + nil single nil] + "Expected `package-desc' parsed from simple-single-1.3.el.") + +(defvar package-test-dir (expand-file-name "data/package" (file-name-directory load-file-name)) + "Base directory of package test files.") + +(defvar package-test-fake-contents-file + (expand-file-name "archive-contents" package-test-dir) + "Path to a static copy of \"archive-contents\".") + +(defvar package-test-built-file-suffixes '(".tar" "/dir" "/*.info") + "Remove these files when cleaning up a built package.") + +(cl-defmacro with-package-test ((&optional &key file basedir build-dir install) &rest body) + "Set up temporary locations and variables for testing." + (declare (indent 1)) + `(let ((package-user-dir package-test-user-dir) + (package-archives `(("gnu" . ,package-test-dir))) + (old-yes-no-defn (symbol-function 'yes-or-no-p)) + ,@(if build-dir (list (list 'build-dir build-dir) + (list 'build-tar (concat build-dir ".tar"))) + (list (cl-gensym)))) ;; Dummy value so `let' doesn't try to bind `ni= l' + (unwind-protect + (progn + ,(if basedir (list 'cd basedir)) + (setf (symbol-function 'yes-or-no-p) #'ignore) + (unless (file-directory-p package-user-dir) + (mkdir package-user-dir)) + (if (boundp 'build-dir) + (package-test-build-multifile build-dir)) + ,@(when install + (list + (list 'package-refresh-contents) + ;; The two quotes before `package-install' are required! One is + ;; consumed by the macro expansion and the other prevents trying to + ;; take the `symbol-value' of `package-install' + (list 'mapc ''package-install install))) + (with-temp-buffer + ,(if file + (list 'insert-file-contents file)) + ,@body)) + ,(if build-dir + (list 'package-test-cleanup-built-files build-dir)) + (when (file-directory-p package-test-user-dir) + (delete-directory package-test-user-dir t)) + (setf (symbol-function 'yes-or-no-p) old-yes-no-defn)))) + +(defun package-test-install-texinfo (file) + "Install from texinfo FILE. + +FILE should be a .texinfo file relative to the current +`default-directory'" + (require 'info) + (let* ((full-file (expand-file-name file)) + (info-file (replace-regexp-in-string "\\.texi\\'" ".info" full-file)) + (old-info-defn (symbol-function 'Info-revert-find-node))) + (require 'info) + (setf (symbol-function 'Info-revert-find-node) #'ignore) + (with-current-buffer (find-file-literally full-file) + (unwind-protect + (progn + (require 'makeinfo) + (makeinfo-buffer) + ;; Give `makeinfo-buffer' a chance to finish + (while compilation-in-progress + (sit-for 0.1)) + (call-process "ginstall-info" nil nil nil + (format "--info-dir=3D%s" default-directory) + (format "%s" info-file))) + (kill-buffer) + (setf (symbol-function 'Info-revert-find-node) old-info-defn))))) + +(defun package-test-build-multifile (dir) + "Build a tar package from a multiple-file directory DIR. + +DIR must not have a trailing slash." + (let* ((pkg-dirname (file-name-nondirectory dir)) + (pkg-name (package-strip-version pkg-dirname)) + (pkg-version (match-string-no-properties 2 pkg-dirname)) + (tar-name (concat pkg-dirname ".tar")) + (default-directory (expand-file-name dir))) + (package-test-install-texinfo (concat pkg-name ".texi")) + (setq default-directory (file-name-directory default-directory)) + (call-process "tar" nil nil nil "-caf" tar-name pkg-dirname))) + +(defun package-test-suffix-matches (base suffix-list) + "Return file names matching BASE concatenated with each item in SUFFIX-L= IST" + (cl-mapcan + '(lambda (item) (file-expand-wildcards (concat base item))) + suffix-list)) + +(defun package-test-cleanup-built-files (dir) + "Remove files which were the result of creating a tar archive. + +DIR is the base name of the package directory, without the trailing slash" + (let* ((pkg-dirname (file-name-nondirectory dir))) + (dolist (file (package-test-suffix-matches dir package-test-built-file-suffixes)) + (delete-file file)))) + +(defun package-test-search-tar-file (filename) + "Search the current buffer's `tar-parse-info' variable for FILENAME. + +Must called from within a `tar-mode' buffer." + (cl-dolist (header tar-parse-info) + (let ((tar-name (tar-header-name header))) + (when (string=3D tar-name filename) + (cl-return t))))) + +(ert-deftest package-test-buffer-info () + "Parse an elisp buffer to get a `package-desc' object." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el"= ) + (should (equal (package-buffer-info) simple-single-desc)))) + +(ert-deftest package-test-install-single () + "Install a single file without using an archive." + (with-package-test (:basedir "data/package" :file "simple-single-1.3.el"= ) + (should (package-install-from-buffer (package-buffer-info))) + (let* ((simple-pkg-dir (file-name-as-directory + (expand-file-name + "simple-single-1.3" + package-test-user-dir))) + (autoloads-file (expand-file-name "simple-single-autoloads.el" simple-pkg-dir))) + (should (file-directory-p simple-pkg-dir)) + (with-temp-buffer + (insert-file-contents (expand-file-name "simple-single-pkg.el" simple-pkg-dir)) + (should (string=3D (buffer-string) + "(define-package \"simple-single\" \"1.3\" \"A single-file package with no dependencies\" nil)\n"))) + (should (file-exists-p autoloads-file)) + (should-not (get-file-buffer autoloads-file))))) + +(ert-deftest package-test-refresh-contents () + "Parse an \"archive-contents\" file." + (with-package-test () + (package-refresh-contents))) + +(ert-deftest package-test-install-single-from-archive () + "Install a single package from a package archive." + (with-package-test () + (package-refresh-contents) + (package-install 'simple-single))) + +(ert-deftest package-test-build-multifile () + "Build a multi-file archive." + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2.3= ") + (should (file-exists-p build-tar)) + (let ((suffixes + (remove build-tar (package-test-suffix-matches + build-dir + package-test-built-file-suffixes)))) + (with-current-buffer (find-file build-tar) + (dolist (file suffixes) + (should (package-test-search-tar-file file))) + (kill-buffer))))) + +(ert-deftest package-test-install-multifile () + "Check properties of the installed multi-file package." + (let ((autoload-file + (expand-file-name "multi-file-autoloads.el" + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir))) + (installed-files '("dir" "multi-file.info" "multi-file-sub.elc" + "multi-file-autoloads.el" "multi-file.elc")) + (autoload-forms '("^(defvar multi-file-custom-var" + "^(custom-autoload 'multi-file-custom-var" + "^(autoload 'multi-file-mode" + "^(provide 'multi-file-autoloads)")) + (pkg-dir (file-name-as-directory + (expand-file-name + "multi-file-0.2.3" + package-test-user-dir)))) + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2= .3" + :install '(multi-file) + :file autoload-file) + (should (package-installed-p 'multi-file)) + (dolist (fn installed-files) + (should (file-exists-p (expand-file-name fn pkg-dir)))) + (dolist (re autoload-forms) + (goto-char (point-min)) + (should (re-search-forward re nil t)))))) + +(ert-deftest package-test-tar-desc () + "Examine the properties parsed from a tar package" + (with-package-test (:basedir "data/package" :build-dir "multi-file-0.2.3= ") + (let ((info (package-tar-file-info (expand-file-name build-tar)))) + (should (eq (package-desc-name info) 'multi-file)) + (should (equal (package-desc-version info) '(0 2 3))) + (should (equal (package-desc-summary info) "Example of a multi-file tar package")) + (should (equal (package-desc-reqs info) nil)) + (should (equal (package-desc-kind info) 'tar)) + ;; (should (equal (package-desc-commentary info) "This is a bare-bones readme file for the multi-file package.\n")) + ))) + +(ert-deftest package-test-update-listing () + "Ensure installed package status is updated." + (with-package-test + () + (let ((buf (package-list-packages))) + (search-forward-regexp "^ +simple-single") + (package-menu-mark-install) + (package-menu-execute) + (should (package-installed-p 'simple-single)) + (switch-to-buffer "*Packages*") + (goto-char (point-min)) + (should (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+installed" nil t)) + (goto-char (point-min)) + (should-not (re-search-forward "^\\s-+simple-single\\s-+1.3\\s-+available" nil t)) + (kill-buffer buf)))) + +(provide 'package-test) + +;;; package-test.el ends here