summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/bytecomp.el14
-rw-r--r--lisp/emacs-lisp/cl-loaddefs.el8
-rw-r--r--lisp/emacs-lisp/ert.el9
-rw-r--r--lisp/emacs-lisp/package-x.el255
-rw-r--r--lisp/emacs-lisp/package.el177
5 files changed, 269 insertions, 194 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index c9a85edfca4..5a87f590020 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4071,7 +4071,8 @@ binding slots have been popped."
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
(byte-compile-warning-enabled-p 'suspicious))
- (byte-compile-warn "`save-excursion' defeated by `set-buffer'"))
+ (byte-compile-warn
+ "Use `with-current-buffer' rather than save-excursion+set-buffer"))
(byte-compile-out 'byte-save-excursion 0)
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
@@ -4120,6 +4121,17 @@ binding slots have been popped."
,@decls
',(nth 1 form)))))
+;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
+;; actually use `toto' in order for this obsolete variable to still work
+;; correctly, so paradoxically, while byte-compiling foo.el, the presence
+;; of a make-obsolete-variable call for `toto' is an indication that `toto'
+;; should not trigger obsolete-warnings in foo.el.
+(byte-defop-compiler-1 make-obsolete-variable)
+(defun byte-compile-make-obsolete-variable (form)
+ (when (eq 'quote (car-safe (nth 1 form)))
+ (push (nth 1 (nth 1 form)) byte-compile-not-obsolete-vars))
+ (byte-compile-normal-call form))
+
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
(when (and (symbolp (nth 1 form))
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 3a6878ed16b..8bcbd67f46b 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -282,7 +282,7 @@ Not documented
;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist
;;;;;; do* do loop return-from return block etypecase typecase ecase
;;;;;; case load-time-value eval-when destructuring-bind function*
-;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "80cb83265399ce021c8c0c7d1a8562f2")
+;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304")
;;; Generated autoloads from cl-macs.el
(autoload 'gensym "cl-macs" "\
@@ -500,16 +500,16 @@ Like `let', but lexically scoped.
The main visible difference is that lambdas inside BODY will create
lexical closures as in Common Lisp.
-\(fn VARLIST BODY)" nil (quote macro))
+\(fn BINDINGS BODY)" nil (quote macro))
(autoload 'lexical-let* "cl-macs" "\
Like `let*', but lexically scoped.
The main visible difference is that lambdas inside BODY, and in
-successive bindings within VARLIST, will create lexical closures
+successive bindings within BINDINGS, will create lexical closures
as in Common Lisp. This is similar to the behavior of `let*' in
Common Lisp.
-\(fn VARLIST BODY)" nil (quote macro))
+\(fn BINDINGS BODY)" nil (quote macro))
(autoload 'multiple-value-bind "cl-macs" "\
Collect multiple return values.
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 5bd8fd01b1e..b2e20843856 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1482,9 +1482,8 @@ Returns the stats object."
(let ((print-escape-newlines t)
(print-level 5)
(print-length 10))
- (let ((begin (point)))
- (ert--pp-with-indentation-and-newline
- (ert-test-result-with-condition-condition result))))
+ (ert--pp-with-indentation-and-newline
+ (ert-test-result-with-condition-condition result)))
(goto-char (1- (point-max)))
(assert (looking-at "\n"))
(delete-char 1)
@@ -1603,7 +1602,7 @@ Nothing more than an interactive interface to `ert-make-test-unbound'."
(defun ert-delete-all-tests ()
"Make all symbols in `obarray' name no test."
(interactive)
- (when (interactive-p)
+ (when (called-interactively-p 'any)
(unless (y-or-n-p "Delete all tests? ")
(error "Aborted")))
;; We can't use `ert-select-tests' here since that gives us only
@@ -1793,7 +1792,7 @@ EWOC and STATS are arguments for `ert--results-update-stats-display'."
BEGIN and END specify a region in the current buffer."
(save-excursion
(save-restriction
- (narrow-to-region begin (point))
+ (narrow-to-region begin end)
;; Inhibit optimization in `debugger-make-xrefs' that would
;; sometimes insert unrelated backtrace info into our buffer.
(let ((debugger-previous-backtrace nil))
diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el
index 61f23abf0a7..cd4b5ee231c 100644
--- a/lisp/emacs-lisp/package-x.el
+++ b/lisp/emacs-lisp/package-x.el
@@ -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))
+ (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))))))))
(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)
@@ -269,4 +306,4 @@ This should be invoked from the gnus *Summary* buffer."
(provide 'package-x)
-;;; package.el ends here
+;;; package-x.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 2552ad4eb68..5dc2938fe08 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -319,20 +319,39 @@ Like `package-alist', but maps package name to a second alist.
The inner alist is keyed by version.")
(put 'package-obsolete-alist 'risky-local-variable t)
-(defconst package-subdirectory-regexp
- "^\\([^.].*\\)-\\([0-9]+\\(?:[.][0-9]+\\)*\\)$"
- "Regular expression matching the name of a package subdirectory.
-The first subexpression is the package name.
-The second subexpression is the version string.")
-
-(defun package-version-join (l)
- "Turn a list of version numbers into a version string."
- (mapconcat 'int-to-string l "."))
+(defun package-version-join (vlist)
+ "Return the version string corresponding to the list VLIST.
+This is, approximately, the inverse of `version-to-list'.
+\(Actually, it returns only one of the possible inverses, since
+`version-to-list' is a many-to-one operation.)"
+ (if (null vlist)
+ ""
+ (let ((str-list (list "." (int-to-string (car vlist)))))
+ (dolist (num (cdr vlist))
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -3)
+ (error "Invalid version list `%s'" vlist))
+ (t
+ ;; pre, or beta, or alpha
+ (cond ((equal "." (car str-list))
+ (pop str-list))
+ ((not (string-match "[0-9]+" (car str-list)))
+ (error "Invalid version list `%s'" vlist)))
+ (push (cond ((= num -1) "pre")
+ ((= num -2) "beta")
+ ((= num -3) "alpha"))
+ str-list))))
+ (if (equal "." (car str-list))
+ (pop str-list))
+ (apply 'concat (nreverse str-list)))))
(defun package-strip-version (dirname)
"Strip the version from a combined package name and version.
E.g., if given \"quux-23.0\", will return \"quux\""
- (if (string-match package-subdirectory-regexp dirname)
+ (if (string-match (concat "\\`" package-subdirectory-regexp "\\'") dirname)
(match-string 1 dirname)))
(defun package-load-descriptor (dir package)
@@ -357,12 +376,13 @@ In each valid package subdirectory, this function loads the
description file containing a call to `define-package', which
updates `package-alist' and `package-obsolete-alist'."
(let ((all (memq 'all package-load-list))
+ (regexp (concat "\\`" package-subdirectory-regexp "\\'"))
name version force)
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
(dolist (subdir (directory-files dir))
(when (and (file-directory-p (expand-file-name subdir dir))
- (string-match package-subdirectory-regexp subdir))
+ (string-match regexp subdir))
(setq name (intern (match-string 1 subdir))
version (match-string 2 subdir)
force (assq name package-load-list))
@@ -554,30 +574,29 @@ EXTRA-PROPERTIES is currently unused."
(package-autoload-ensure-default-file generated-autoload-file))
(update-directory-autoloads pkg-dir)))
-(defun package-untar-buffer ()
+(defvar tar-parse-info)
+(declare-function tar-untar-buffer "tar-mode" ())
+
+(defun package-untar-buffer (dir)
"Untar the current buffer.
-This uses `tar-untar-buffer' if it is available.
-Otherwise it uses an external `tar' program.
-`default-directory' should be set by the caller."
+This uses `tar-untar-buffer' from Tar mode. All files should
+untar into a directory named DIR; otherwise, signal an error."
(require 'tar-mode)
- (if (fboundp 'tar-untar-buffer)
- (progn
- ;; tar-mode messes with narrowing, so we just let it have the
- ;; whole buffer to play with.
- (delete-region (point-min) (point))
- (tar-mode)
- (tar-untar-buffer))
- ;; FIXME: check the result.
- (call-process-region (point) (point-max) "tar" nil '(nil nil) nil
- "xf" "-")))
+ (tar-mode)
+ ;; Make sure everything extracts into DIR.
+ (let ((regexp (concat "\\`" (regexp-quote dir) "/")))
+ (dolist (tar-data tar-parse-info)
+ (unless (string-match regexp (aref tar-data 2))
+ (error "Package does not untar cleanly into directory %s/" dir))))
+ (tar-untar-buffer))
(defun package-unpack (name version)
- (let ((pkg-dir (expand-file-name (concat (symbol-name name) "-" version)
- package-user-dir)))
+ (let* ((dirname (concat (symbol-name name) "-" version))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
(make-directory package-user-dir t)
;; FIXME: should we delete PKG-DIR if it exists?
(let* ((default-directory (file-name-as-directory package-user-dir)))
- (package-untar-buffer)
+ (package-untar-buffer dirname)
(package-generate-autoloads (symbol-name name) pkg-dir)
(let ((load-path (cons pkg-dir load-path)))
(byte-recompile-directory pkg-dir 0 t)))))
@@ -592,7 +611,9 @@ Otherwise it uses an external `tar' program.
(if (string= file-name "package")
(package--write-file-no-coding
(expand-file-name (concat file-name ".el") package-user-dir))
- (let* ((pkg-dir (expand-file-name (concat file-name "-" version)
+ (let* ((pkg-dir (expand-file-name (concat file-name "-"
+ (package-version-join
+ (version-to-list version)))
package-user-dir))
(el-file (expand-file-name (concat file-name ".el") pkg-dir))
(pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir)))
@@ -848,15 +869,17 @@ The package is found on one of the archives in `package-archives'."
;; Try to activate it.
(package-initialize))
-(defun package-strip-rcs-id (v-str)
- "Strip RCS version ID from the version string.
+(defun package-strip-rcs-id (str)
+ "Strip RCS version ID from the version string STR.
If the result looks like a dotted numeric version, return it.
Otherwise return nil."
- (if v-str
- (if (string-match "^[ \t]*[$]Revision:[ \t]\([0-9.]+\)[ \t]*[$]$" v-str)
- (match-string 1 v-str)
- (if (string-match "^[0-9.]*$" v-str)
- v-str))))
+ (when str
+ (when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
+ (setq str (substring str (match-end 0))))
+ (condition-case nil
+ (if (version-to-list str)
+ str)
+ (error nil))))
(defun package-buffer-info ()
"Return a vector describing the package in the current buffer.
@@ -911,43 +934,47 @@ boundaries."
"Find package information for a tar file.
FILE is the name of the tar file to examine.
The return result is a vector like `package-buffer-info'."
- (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file)
- (error "Invalid package name `%s'" file))
- (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file)))
- (pkg-version (match-string-no-properties 2 file))
- ;; Extract the package descriptor.
- (pkg-def-contents (shell-command-to-string
- ;; Requires GNU tar.
- (concat "tar -xOf " file " "
- pkg-name "-" pkg-version "/"
- pkg-name "-pkg.el")))
- (pkg-def-parsed (package-read-from-string pkg-def-contents)))
- (unless (eq (car pkg-def-parsed) 'define-package)
- (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
- (let ((name-str (nth 1 pkg-def-parsed))
- (version-string (nth 2 pkg-def-parsed))
- (docstring (nth 3 pkg-def-parsed))
- (requires (nth 4 pkg-def-parsed))
- (readme (shell-command-to-string
- ;; Requires GNU tar.
- (concat "tar -xOf " file " "
- pkg-name "-" pkg-version "/README"))))
- (unless (equal pkg-version version-string)
- (error "Package has inconsistent versions"))
- (unless (equal pkg-name name-str)
- (error "Package has inconsistent names"))
- ;; Kind of a hack.
- (if (string-match ": Not found in archive" readme)
- (setq readme nil))
- ;; Turn string version numbers into list form.
- (if (eq (car requires) 'quote)
- (setq requires (car (cdr requires))))
- (setq requires
- (mapcar (lambda (elt)
- (list (car elt)
- (version-to-list (cadr elt))))
- requires))
- (vector pkg-name requires docstring version-string readme))))
+ (let ((default-directory (file-name-directory file))
+ (file (file-name-nondirectory file)))
+ (unless (string-match (concat "\\`" package-subdirectory-regexp "\\.tar\\'")
+ file)
+ (error "Invalid package name `%s'" file))
+ (let* ((pkg-name (match-string-no-properties 1 file))
+ (pkg-version (match-string-no-properties 2 file))
+ ;; Extract the package descriptor.
+ (pkg-def-contents (shell-command-to-string
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+
+ pkg-name "-" pkg-version "/"
+ pkg-name "-pkg.el")))
+ (pkg-def-parsed (package-read-from-string pkg-def-contents)))
+ (unless (eq (car pkg-def-parsed) 'define-package)
+ (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name))
+ (let ((name-str (nth 1 pkg-def-parsed))
+ (version-string (nth 2 pkg-def-parsed))
+ (docstring (nth 3 pkg-def-parsed))
+ (requires (nth 4 pkg-def-parsed))
+ (readme (shell-command-to-string
+ ;; Requires GNU tar.
+ (concat "tar -xOf " file " "
+ pkg-name "-" pkg-version "/README"))))
+ (unless (equal pkg-version version-string)
+ (error "Package has inconsistent versions"))
+ (unless (equal pkg-name name-str)
+ (error "Package has inconsistent names"))
+ ;; Kind of a hack.
+ (if (string-match ": Not found in archive" readme)
+ (setq readme nil))
+ ;; Turn string version numbers into list form.
+ (if (eq (car requires) 'quote)
+ (setq requires (car (cdr requires))))
+ (setq requires
+ (mapcar (lambda (elt)
+ (list (car elt)
+ (version-to-list (cadr elt))))
+ requires))
+ (vector pkg-name requires docstring version-string readme)))))
;;;###autoload
(defun package-install-from-buffer (pkg-info type)
@@ -1037,7 +1064,7 @@ makes them available for download."
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(dolist (archive package-archives)
- (condition-case nil
+ (condition-case-no-debug nil
(package--download-one-archive archive "archive-contents")
(error (message "Failed to download `%s' archive."
(car archive)))))
@@ -1465,7 +1492,7 @@ packages marked for deletion are removed."
delete-list
", "))))
(dolist (elt delete-list)
- (condition-case err
+ (condition-case-no-debug err
(package-delete (car elt) (cdr elt))
(error (message (cadr err)))))
(error "Aborted")))
View Lorry Controller Status