;;; package.el --- Simple package system for Emacs -*- lexical-binding:t -*-
-;; Copyright (C) 2007-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Daniel Hackney <dan@haxney.org>
:group 'package
:version "24.1")
+(defcustom package-archive-priorities nil
+ "An alist of priorities for packages.
+
+Each element has the form (ARCHIVE-ID . PRIORITY).
+
+When installing packages, the package with the highest version
+number from the archive with the highest priority is
+selected. When higher versions are available from archives with
+lower priorities, the user has to select those manually.
+
+Archives not in this list have the priority 0."
+ :type '(alist :key-type (string :tag "Archive name")
+ :value-type (integer :tag "Priority (default is 0)"))
+ :risky t
+ :group 'package
+ :version "25.1")
+
(defcustom package-pinned-packages nil
"An alist of packages that are pinned to specific archives.
This can be useful if you have multiple package archives enabled,
(pcase (package-desc-kind pkg-desc)
(`single ".el")
(`tar ".tar")
+ (`dir "")
(kind (error "Unknown package kind: %s" kind))))
(defun package-desc--keywords (pkg-desc)
(dirname (package-desc-full-name pkg-desc))
(pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
+ (`dir
+ (make-directory pkg-dir t)
+ (let ((file-list
+ (directory-files
+ default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
+ (dolist (source-file file-list)
+ (let ((target-el-file
+ (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
+ (copy-file source-file target-el-file t)))
+ ;; Now that the files have been installed, this package is
+ ;; indistinguishable from a `tar' or a `single'. Let's make
+ ;; things simple by ensuring we're one of them.
+ (setf (package-desc-kind pkg-desc)
+ (if (> (length file-list) 1) 'tar 'single))))
(`tar
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
(defun package-install-from-archive (pkg-desc)
"Download and install a tar package."
+ ;; This won't happen, unless the archive is doing something wrong.
+ (when (eq (package-desc-kind pkg-desc) 'dir)
+ (error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
(package-desc-suffix pkg-desc)))
;; Older archive-contents files have only 4
;; elements here.
(package--ac-desc-extras (cdr package)))))
- (existing-packages (assq name package-archive-contents))
(pinned-to-archive (assoc name package-pinned-packages)))
- (cond
- ;; Skip entirely if pinned to another archive.
- ((and pinned-to-archive
- (not (equal (cdr pinned-to-archive) archive)))
- nil)
- ((not existing-packages)
- (push (list name pkg-desc) package-archive-contents))
- (t
- (while
- (if (and (cdr existing-packages)
- (version-list-<
- version (package-desc-version (cadr existing-packages))))
- (setq existing-packages (cdr existing-packages))
- (push pkg-desc (cdr existing-packages))
- nil))))))
+ ;; Skip entirely if pinned to another archive.
+ (when (not (and pinned-to-archive
+ (not (equal (cdr pinned-to-archive) archive))))
+ (setq package-archive-contents
+ (package--append-to-alist pkg-desc package-archive-contents)))))
+
+(defun package--append-to-alist (pkg-desc alist)
+ "Append an entry for PKG-DESC to the start of ALIST and return it.
+This entry takes the form (`package-desc-name' PKG-DESC).
+
+If ALIST already has an entry with this name, destructively add
+PKG-DESC to the cdr of this entry instead, sorted by version
+number."
+ (let* ((name (package-desc-name pkg-desc))
+ (priority-version (package-desc-priority-version pkg-desc))
+ (existing-packages (assq name alist)))
+ (if (not existing-packages)
+ (cons (list name pkg-desc)
+ alist)
+ (while (if (and (cdr existing-packages)
+ (version-list-< priority-version
+ (package-desc-priority-version
+ (cadr existing-packages))))
+ (setq existing-packages (cdr existing-packages))
+ (push pkg-desc (cdr existing-packages))
+ nil))
+ alist)))
(defun package-download-transaction (packages)
"Download and install all the packages in PACKAGES.
(unless tar-desc
(error "No package descriptor file found"))
(with-current-buffer (tar--extract tar-desc)
- (goto-char (point-min))
(unwind-protect
- (let* ((pkg-def-parsed (read (current-buffer)))
- (pkg-desc
- (if (not (eq (car pkg-def-parsed) 'define-package))
- (error "Can't find define-package in %s"
- (tar-header-name tar-desc))
- (apply #'package-desc-from-define
- (append (cdr pkg-def-parsed))))))
- (setf (package-desc-kind pkg-desc) 'tar)
- pkg-desc)
+ (package--read-pkg-desc 'tar)
(kill-buffer (current-buffer))))))
+(defun package-dir-info ()
+ "Find package information for a directory.
+The return result is a `package-desc'."
+ (cl-assert (derived-mode-p 'dired-mode))
+ (let* ((desc-file (package--description-file default-directory)))
+ (if (file-readable-p desc-file)
+ (with-temp-buffer
+ (insert-file-contents desc-file)
+ (package--read-pkg-desc 'dir))
+ (let ((files (directory-files default-directory t "\\.el\\'" t))
+ info)
+ (while files
+ (with-temp-buffer
+ (insert-file-contents (pop files))
+ ;; When we find the file with the data,
+ (when (setq info (ignore-errors (package-buffer-info)))
+ ;; stop looping,
+ (setq files nil)
+ ;; set the 'dir kind,
+ (setf (package-desc-kind info) 'dir))))
+ ;; and return the info.
+ info))))
+
+(defun package--read-pkg-desc (kind)
+ "Read a `define-package' form in current buffer.
+Return the pkg-desc, with desc-kind set to KIND."
+ (goto-char (point-min))
+ (unwind-protect
+ (let* ((pkg-def-parsed (read (current-buffer)))
+ (pkg-desc
+ (if (not (eq (car pkg-def-parsed) 'define-package))
+ (error "Can't find define-package in %s"
+ (tar-header-name tar-desc))
+ (apply #'package-desc-from-define
+ (append (cdr pkg-def-parsed))))))
+ (setf (package-desc-kind pkg-desc) kind)
+ pkg-desc)))
+
;;;###autoload
(defun package-install-from-buffer ()
"Install a package from the current buffer.
-The current buffer is assumed to be a single .el or .tar file that follows the
-packaging guidelines; see info node `(elisp)Packaging'.
+The current buffer is assumed to be a single .el or .tar file or
+a directory. These must follow the packaging guidelines (see
+info node `(elisp)Packaging').
+
+Specially, if current buffer is a directory, the -pkg.el
+description file is not mandatory, in which case the information
+is derived from the main .el file in the directory.
+
Downloads and installs required packages as needed."
(interactive)
- (let ((pkg-desc (if (derived-mode-p 'tar-mode)
- (package-tar-file-info)
- (package-buffer-info))))
+ (let ((pkg-desc
+ (cond
+ ((derived-mode-p 'dired-mode)
+ ;; This is the only way a package-desc object with a `dir'
+ ;; desc-kind can be created. Such packages can't be
+ ;; uploaded or installed from archives, they can only be
+ ;; installed from local buffers or directories.
+ (package-dir-info))
+ ((derived-mode-p 'tar-mode)
+ (package-tar-file-info))
+ (t
+ (package-buffer-info)))))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
(transaction (package-compute-transaction nil requires)))
The file can either be a tar file or an Emacs Lisp file."
(interactive "fPackage file name: ")
(with-temp-buffer
- (insert-file-contents-literally file)
- (when (string-match "\\.tar\\'" file) (tar-mode))
+ (if (file-directory-p file)
+ (progn
+ (setq default-directory file)
+ (dired-mode))
+ (insert-file-contents-literally file)
+ (when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
(defun package-delete (pkg-desc)
"Return the archive containing the package NAME."
(cdr (assoc (package-desc-archive desc) package-archives)))
+(defun package-archive-priority (archive)
+ "Return the priority of ARCHIVE.
+
+The archive priorities are specified in
+`package-archive-priorities'. If not given there, the priority
+defaults to 0."
+ (or (cdr (assoc archive package-archive-priorities))
+ 0))
+
+(defun package-desc-priority-version (pkg-desc)
+ "Return the version PKG-DESC with the archive priority prepended.
+
+This allows for easy comparison of package versions from
+different archives if archive priorities are meant to be taken in
+consideration."
+ (cons (package-archive-priority
+ (package-desc-archive pkg-desc))
+ (package-desc-version pkg-desc)))
+
(defun package--download-one-archive (archive file)
"Retrieve an archive file FILE from ARCHIVE, and cache it.
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
(status (aref (cadr entry) 2)))
- (cond ((member status '("installed" "unsigned"))
- (push pkg-desc installed))
- ((member status '("available" "new"))
- (push (cons (package-desc-name pkg-desc) pkg-desc)
- available)))))
+ (cond ((member status '("installed" "unsigned"))
+ (push pkg-desc installed))
+ ((member status '("available" "new"))
+ (setq available (package--append-to-alist pkg-desc available))))))
;; Loop through list of installed packages, finding upgrades.
(dolist (pkg-desc installed)
- (let ((avail-pkg (assq (package-desc-name pkg-desc) available)))
- (and avail-pkg
- (version-list-< (package-desc-version pkg-desc)
- (package-desc-version (cdr avail-pkg)))
- (push avail-pkg upgrades))))
+ (let* ((name (package-desc-name pkg-desc))
+ (avail-pkg (cadr (assq name available))))
+ (and avail-pkg
+ (version-list-< (package-desc-priority-version pkg-desc)
+ (package-desc-priority-version avail-pkg))
+ (push (cons name avail-pkg) upgrades))))
upgrades))
(defun package-menu-mark-upgrades ()