From 7fe42546dd03801d190684ae29ced8e13b192156 Mon Sep 17 00:00:00 2001 From: Jambunathan K Date: Fri, 25 Feb 2011 13:30:00 -0500 Subject: [PATCH] Fix package uploading for newly made or local archives. * emacs-lisp/package-x.el (package--archive-contents-from-url) (package--archive-contents-from-file): New functions. (package-update-news-on-upload): New var. (package-upload-buffer-internal): Extract archive-contents from package-archive-upload-base if it is not found at archive-url. Obey package-update-news-on-upload. (package-upload-buffer, package-upload-file): Doc fix. --- lisp/ChangeLog | 10 ++++ lisp/emacs-lisp/package-x.el | 89 +++++++++++++++++++++++++++--------- 2 files changed, 77 insertions(+), 22 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c44c491cad0..b59b11590d0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2011-02-25 Jambunathan K + + * emacs-lisp/package-x.el (package--archive-contents-from-url) + (package--archive-contents-from-file): New functions. + (package-update-news-on-upload): New var. + (package-upload-buffer-internal): Extract archive-contents from + package-archive-upload-base if it is not found at archive-url. + Obey package-update-news-on-upload. + (package-upload-buffer, package-upload-file): Doc fix. + 2011-02-24 Glenn Morris * files-x.el (modify-dir-local-variable): Handle dir-locals from diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index b9994be3d39..61f23abf0a7 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -40,6 +40,9 @@ (defvar package-archive-upload-base nil "Base location for uploading to package archive.") +(defvar package-update-news-on-upload nil + "Whether package upload should also update NEWS and RSS feeds.") + (defun package--encode (string) "Encode a string by replacing some characters with XML entities." ;; We need a special case for translating "&" to "&". @@ -86,6 +89,36 @@ (unless old-buffer (kill-buffer (current-buffer))))))) +(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)))))) + +(defun package--archive-contents-from-file (file) + "Parse the given archive-contents file." + (if (not (file-exists-p file)) + ;; no existing archive-contents, possibly a new ELPA repo. + (list package-archive-version) + (let ((dont-kill (find-buffer-visiting file))) + (with-current-buffer (let ((find-file-visit-truename t)) + (find-file-noselect file)) + (prog1 + (package-read-from-string + (buffer-substring-no-properties (point-min) (point-max))) + (unless dont-kill + (kill-buffer (current-buffer)))))))) + (defun package-maint-add-news-item (title description archive-url) "Add a news item to the ELPA web pages. TITLE is the title of the news item. @@ -111,11 +144,20 @@ PKG-INFO is the package info, see `package-buffer-info'. EXTENSION is the file extension, a string. It can be either \"el\" or \"tar\". +The variable `package-archive-upload-base' specifies the upload +destination. If this is nil, signal an error. + Optional arg ARCHIVE-URL is the URL of the destination archive. -If nil, the \"gnu\" archive is used." - (unless archive-url - (or (setq archive-url (cdr (assoc "gnu" package-archives))) - (error "No destination URL"))) +If it is non-nil, compute the new \"archive-contents\" file +starting from the existing \"archive-contents\" at that URL. In +addition, if `package-update-news-on-upload' is non-nil, call +`package--update-news' to add a news item at that URL. + +If ARCHIVE-URL is nil, compute the new \"archive-contents\" file +from the \"archive-contents\" at `package-archive-upload-base', +if it exists." + (unless package-archive-upload-base + (error "No destination specified in `package-archive-upload-base'")) (save-excursion (save-restriction (let* ((file-type (cond @@ -131,21 +173,14 @@ If nil, the \"gnu\" archive is used." (pkg-version (aref pkg-info 3)) (commentary (aref pkg-info 4)) (split-version (version-to-list pkg-version)) - (pkg-buffer (current-buffer)) + (pkg-buffer (current-buffer))) - ;; Download latest archive-contents. - (buffer (url-retrieve-synchronously - (concat archive-url "archive-contents")))) - - ;; 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)))) + ;; 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 + (concat package-archive-upload-base + "archive-contents")))) (new-desc (vector split-version requires desc file-type))) (if (> (car contents) package-archive-version) (error "Unrecognized archive version %d" (car contents))) @@ -176,7 +211,6 @@ If nil, the \"gnu\" archive is used." (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 @@ -184,8 +218,10 @@ If nil, the \"gnu\" archive is used." nil nil nil 'excl) ;; Write a news entry. - (package--update-news (concat file-name "." extension) - pkg-version desc archive-url) + (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. @@ -196,7 +232,9 @@ If nil, the \"gnu\" archive is used." nil nil nil 'ask))))))) (defun package-upload-buffer () - "Upload a single .el file to ELPA from the current buffer." + "Upload the current buffer as a single-file Emacs Lisp package. +The variable `package-archive-upload-base' specifies the upload +destination." (interactive) (save-excursion (save-restriction @@ -205,6 +243,13 @@ If nil, the \"gnu\" archive is used." (package-upload-buffer-internal pkg-info "el"))))) (defun package-upload-file (file) + "Upload the Emacs Lisp package FILE to the package archive. +Interactively, prompt for FILE. The package is considered a +single-file package if FILE ends in \".el\", and a multi-file +package if FILE ends in \".tar\". + +The variable `package-archive-upload-base' specifies the upload +destination." (interactive "fPackage file name: ") (with-temp-buffer (insert-file-contents-literally file) -- 2.39.5