;;; package-x.el --- Package extras
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2015 Free Software Foundation, Inc.
;; Author: Tom Tromey <tromey@redhat.com>
;; Created: 10 Mar 2007
-;; Version: 0.9
;; Keywords: tools
;; Package: package
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(defun package--archive-contents-from-url (archive-url)
"Parse archive-contents file at ARCHIVE-URL.
Return the file contents, as a string, or nil if unsuccessful."
- (ignore-errors
- (when archive-url
- (let* ((buffer (url-retrieve-synchronously
- (concat archive-url "archive-contents"))))
- (set-buffer buffer)
- (package-handle-response)
- (re-search-forward "^$" nil 'move)
- (forward-char)
- (delete-region (point-min) (point))
- (prog1 (package-read-from-string
- (buffer-substring-no-properties (point-min) (point-max)))
- (kill-buffer buffer))))))
+ (when archive-url
+ (with-temp-buffer
+ (ignore-errors
+ (url-insert-file-contents (concat archive-url "archive-contents"))
+ (package-read-from-string
+ (buffer-substring-no-properties (point-min) (point-max)))))))
(defun package--archive-contents-from-file ()
"Parse the archive-contents at `package-archive-upload-base'"
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\".
(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))
- (split-version (version-to-list pkg-version))
+ (package-desc-summary pkg-desc)))
+ (split-version (package-desc-version pkg-desc))
+ (commentary
+ (pcase file-type
+ (`single (lm-commentary))
+ (`tar nil))) ;; FIXME: Get it from the README file.
+ (extras (package-desc-extras pkg-desc))
+ (pkg-version (package-version-join split-version))
(pkg-buffer (current-buffer)))
;; Get archive-contents from ARCHIVE-URL if it's non-nil, or
;; 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 extras)))
(if (> (car contents) package-archive-version)
(error "Unrecognized archive version %d" (car contents)))
(let ((elt (assq pkg-name (cdr contents))))
(if elt
(if (version-list-<= split-version
- (package-desc-vers (cdr elt)))
+ (package--ac-desc-version (cdr elt)))
(error "New package has smaller version: %s" pkg-version)
(setcdr elt new-desc))
(setq contents (cons (car contents)
;; 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
;; 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))))))))
(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.
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)))))
+ (insert-file-contents file)
+ (let ((pkg-desc
+ (cond
+ ((string-match "\\.tar\\'" file)
+ (tar-mode) (package-tar-file-info))
+ ((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.