- ;; Parse archive-contents.
- (set-buffer buffer)
- (package-handle-response)
- (re-search-forward "^$" nil 'move)
- (forward-char)
- (delete-region (point-min) (point))
- (let ((contents (package-read-from-string
- (buffer-substring-no-properties (point-min)
- (point-max))))
- (new-desc (vector 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))))
- (if elt
- (if (version-list-<= split-version
- (package-desc-vers (cdr elt)))
- (error "New package has smaller version: %s" pkg-version)
- (setcdr elt new-desc))
- (setq contents (cons (car contents)
- (cons (cons pkg-name new-desc)
- (cdr contents))))))
-
- ;; Now CONTENTS is the updated archive contents. Upload
- ;; this and the package itself. For now we assume ELPA is
- ;; writable via file primitives.
- (let ((print-level nil)
- (print-length nil))
- (write-region (concat (pp-to-string contents) "\n")
- nil
- (concat package-archive-upload-base
- "archive-contents")))
-
- ;; If there is a commentary section, write it.
- (when commentary
- (write-region commentary nil
- (concat package-archive-upload-base
- (symbol-name pkg-name) "-readme.txt")))
-
- (set-buffer pkg-buffer)
- (kill-buffer buffer)
- (write-region (point-min) (point-max)
- (concat package-archive-upload-base
- file-name "-" pkg-version
- "." extension)
- nil nil nil 'excl)
-
- ;; Write a news entry.
- (package--update-news (concat file-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")
- (write-region (point-min) (point-max)
- (concat package-archive-upload-base
- file-name "." extension)
- nil nil nil 'ask)))))))
+If ARCHIVE-URL is nil, compute the new \"archive-contents\" file
+from the \"archive-contents\" at `package-archive-upload-base',
+if it exists."
+ (let ((package-archive-upload-base package-archive-upload-base))
+ ;; Check if `package-archive-upload-base' is valid.
+ (when (or (not (stringp package-archive-upload-base))
+ (equal package-archive-upload-base
+ (car-safe
+ (get 'package-archive-upload-base 'standard-value))))
+ (setq package-archive-upload-base
+ (read-directory-name
+ "Base directory for package archive: ")))
+ (unless (file-directory-p package-archive-upload-base)
+ (if (y-or-n-p (format "%s does not exist; create it? "
+ package-archive-upload-base))
+ (make-directory package-archive-upload-base t)
+ (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) "")
+ (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))
+ (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)))
+ (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)))
+ (error "New package has smaller version: %s" pkg-version)
+ (setcdr elt new-desc))
+ (setq contents (cons (car contents)
+ (cons (cons pkg-name new-desc)
+ (cdr contents))))))
+
+ ;; Now CONTENTS is the updated archive contents. Upload
+ ;; this and the package itself. For now we assume ELPA is
+ ;; writable via file primitives.
+ (let ((print-level nil)
+ (print-length nil))
+ (write-region (concat (pp-to-string contents) "\n")
+ nil
+ (expand-file-name "archive-contents"
+ package-archive-upload-base)))
+
+ ;; 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)))
+
+ (set-buffer pkg-buffer)
+ (write-region (point-min) (point-max)
+ (expand-file-name
+ (concat file-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)
+ 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")
+ (write-region (point-min) (point-max)
+ (expand-file-name
+ (concat file-name "." extension)
+ package-archive-upload-base)
+ nil nil nil 'ask))))))))