Commit 5c69cb2c authored by Chong Yidong's avatar Chong Yidong
Browse files

Usability improvements to commands in package-x.el.

* lisp/emacs-lisp/package-x.el (package-archive-upload-base): Make it a
defcustom.
(package--update-file): Doc fix.  Accept relative file names.
(package--archive-contents-from-file): Remove the argument, since
it's necessarily always "archive-contents".
(package-maint-add-news-item): Pass relative file name args to
package--update-file.
(package-upload-buffer-internal): Prompt for a destination if
package-archive-upload-base is invalid.  Create the directory if
it does not exist.
(package-upload-buffer, package-upload-file): Doc fix.
parent 78f5433f
2011-03-06 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/package-x.el (package-archive-upload-base): Make it a
defcustom.
(package--update-file): Doc fix. Accept relative file names.
(package--archive-contents-from-file): Remove the argument, since
it's necessarily always "archive-contents".
(package-maint-add-news-item): Pass relative file name args to
package--update-file.
(package-upload-buffer-internal): Prompt for a destination if
package-archive-upload-base is invalid. Create the directory if
it does not exist.
(package-upload-buffer, package-upload-file): Doc fix.
2011-03-06 Chong Yidong <cyd@stupidchicken.com>
 
* isearch.el (isearch-mode-map): Bind C-y to isearch-yank-kill,
......
......@@ -27,21 +27,41 @@
;;; Commentary:
;; This file currently contains parts of the package system most
;; people won't need, such as package uploading.
;; This file currently contains parts of the package system that many
;; won't need, such as package uploading.
;; To upload to an archive, first set `package-archive-upload-base' to
;; some desired directory. For testing purposes, you can specify any
;; directory you want, but if you want the archive to be accessible to
;; others via http, this is typically a directory in the /var/www tree
;; (possibly one on a remote machine, accessed via Tramp).
;; Then call M-x package-upload-file, which prompts for a file to
;; upload. Alternatively, M-x package-upload-buffer uploads the
;; current buffer, if it's visiting a package file.
;; Once a package is uploaded, users can access it via the Package
;; Menu, by adding the archive to `package-archives'.
;;; Code:
(require 'package)
(defvar gnus-article-buffer)
;; Note that this only works if you have the password, which you
;; probably don't :-).
(defvar package-archive-upload-base nil
"Base location for uploading to package archive.")
(defcustom package-archive-upload-base "/path/to/archive"
"The base location of the archive to which packages are uploaded.
This should be an absolute directory name. If the archive is on
another machine, you may specify a remote name in the usual way,
e.g. \"/ssh:foo@example.com:/var/www/packages/\".
See Info node `(emacs)Remote Files'.
Unlike `package-archives', you can't specify a HTTP URL."
:type 'directory
:group 'package
:version "24.1")
(defvar package-update-news-on-upload nil
"Whether package upload should also update NEWS and RSS feeds.")
"Whether uploading a package should also update NEWS and RSS feeds.")
(defun package--encode (string)
"Encode a string by replacing some characters with XML entities."
......@@ -75,13 +95,18 @@
title " - " (package--encode text)
" </li>\n"))
(defun package--update-file (file location text)
(defun package--update-file (file tag text)
"Update the package archive file named FILE.
FILE should be relative to `package-archive-upload-base'.
TAG is a string that can be found within the file; TEXT is
inserted after its first occurrence in the file."
(setq file (expand-file-name file package-archive-upload-base))
(save-excursion
(let ((old-buffer (find-buffer-visiting file)))
(with-current-buffer (let ((find-file-visit-truename t))
(or old-buffer (find-file-noselect file)))
(goto-char (point-min))
(search-forward location)
(search-forward tag)
(forward-line)
(insert text)
(let ((file-precious-flag t))
......@@ -105,30 +130,31 @@ Return the file contents, as a string, or nil if unsuccessful."
(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--archive-contents-from-file ()
"Parse the archive-contents at `package-archive-upload-base'"
(let ((file (expand-file-name "archive-contents"
package-archive-upload-base)))
(if (not (file-exists-p file))
;; No existing archive-contents means a new archive.
(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.
"Add a news item to the webpages associated with the package archive.
TITLE is the title of the news item.
DESCRIPTION is the text of the news item.
You need administrative access to ELPA to use this."
DESCRIPTION is the text of the news item."
(interactive "sTitle: \nsText: ")
(package--update-file (concat package-archive-upload-base "elpa.rss")
(package--update-file "elpa.rss"
"<description>"
(package--make-rss-entry title description archive-url))
(package--update-file (concat package-archive-upload-base "news.html")
(package--update-file "news.html"
"New entries go here"
(package--make-html-entry title description)))
......@@ -144,8 +170,8 @@ 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.
The upload destination is given by `package-archive-upload-base'.
If its value is invalid, prompt for a directory.
Optional arg ARCHIVE-URL is the URL of the destination archive.
If it is non-nil, compute the new \"archive-contents\" file
......@@ -156,85 +182,97 @@ addition, if `package-update-news-on-upload' is non-nil, call
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
((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
(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)))
(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)
(write-region (point-min) (point-max)
(concat package-archive-upload-base
file-name "-" pkg-version
"." extension)
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)
(concat package-archive-upload-base
file-name "." extension)
nil nil nil 'ask)))))))
(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))
(eq 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))))))))
(defun package-upload-buffer ()
"Upload the current buffer as a single-file Emacs Lisp package.
The variable `package-archive-upload-base' specifies the upload
destination."
If `package-archive-upload-base' does not specify a valid upload
destination, prompt for one."
(interactive)
(save-excursion
(save-restriction
......@@ -247,9 +285,8 @@ destination."
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."
If `package-archive-upload-base' does not specify a valid upload
destination, prompt for one."
(interactive "fPackage file name: ")
(with-temp-buffer
(insert-file-contents-literally file)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment