*** package-x.el	2010-11-01 22:33:40.843750000 +0530
--- package-x-modified.el	2010-11-01 22:33:43.281250000 +0530
***************
*** 40,45 ****
--- 40,48 ----
  (defvar package-archive-upload-base nil
    "Base location for uploading to package archive.")
  
+ (defvar package-update-news-on-upload t
+   "Should package upload 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,91 ****
--- 89,127 ----
  	(unless old-buffer
  	  (kill-buffer (current-buffer)))))))
  
+ (defun package--archive-contents-from-url (&optional archive-url) 
+   "Parse archive-contents file at ARCHIVE-URL.
+ 
+ If ARCHIVE-URL is unspecified the \"gnu\" archive is used."
+   (unless archive-url
+     (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+ 	(error "No destination 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.
***************
*** 107,121 ****
  
  (defun package-upload-buffer-internal (pkg-info extension &optional archive-url)
    "Upload a package whose contents are in the current buffer.
  PKG-INFO is the package info, see `package-buffer-info'.
  EXTENSION is the file extension, a string.  It can be either
  \"el\" or \"tar\".
  
! 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")))
    (save-excursion
      (save-restriction
        (let* ((file-type (cond
--- 143,159 ----
  
  (defun package-upload-buffer-internal (pkg-info extension &optional archive-url)
    "Upload a package whose contents are in the current buffer.
+ By default, package files and archive-contents are uploaded to
+ the `default-directory'. Set `package-archive-upload-base' to
+ override the default behaviour.
  PKG-INFO is the package info, see `package-buffer-info'.
  EXTENSION is the file extension, a string.  It can be either
  \"el\" or \"tar\".
  
! Optional arg ARCHIVE-URL is the URL of the destination archive to
! be embedded in the RSS file. If nil, the \"gnu\" archive is
! used. This arg is effective only when
! `package-update-news-on-upload' is non-nil."
    (save-excursion
      (save-restriction
        (let* ((file-type (cond
***************
*** 132,151 ****
  	     (commentary (aref pkg-info 4))
  	     (split-version (version-to-list pkg-version))
  	     (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))))
  	      (new-desc (vector split-version requires desc file-type)))
  	  (if (> (car contents) package-archive-version)
  	      (error "Unrecognized archive version %d" (car contents)))
--- 170,179 ----
  	     (commentary (aref pkg-info 4))
  	     (split-version (version-to-list pkg-version))
  	     (pkg-buffer (current-buffer))
+ 	     (upload-dir (or package-archive-upload-base default-directory)))
  
! 	(let ((contents (package--archive-contents-from-file
! 			 (concat upload-dir "archive-contents")))
  	      (new-desc (vector split-version requires desc file-type)))
  	  (if (> (car contents) package-archive-version)
  	      (error "Unrecognized archive version %d" (car contents)))
***************
*** 166,197 ****
  		(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)))))))
  
--- 194,228 ----
  		(print-length nil))
  	    (write-region (concat (pp-to-string contents) "\n")
  			  nil
! 			  (concat upload-dir "archive-contents")))
  
  	  ;; If there is a commentary section, write it.
  	  (when commentary
  	    (write-region commentary nil
! 			  (concat upload-dir
  				  (symbol-name pkg-name) "-readme.txt")))
  
  	  (set-buffer pkg-buffer)
  	  (write-region (point-min) (point-max)
! 			(concat upload-dir
  				file-name "-" pkg-version
  				"." extension)
  			nil nil nil 'excl)
  
  	  ;; Write a news entry.
+ 	  (when package-update-news-on-upload
+ 	    (unless archive-url
+ 	      (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+ 		  (error "No destination 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)
! 			    (concat upload-dir
  				    file-name "." extension)
  			    nil nil nil 'ask)))))))