[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] xwidget b7541df 3/4: Merge branch 'master' into xwidget
|
From: |
Joakim Verona |
|
Subject: |
[Emacs-diffs] xwidget b7541df 3/4: Merge branch 'master' into xwidget |
|
Date: |
Tue, 03 Feb 2015 00:12:52 +0000 |
branch: xwidget
commit b7541dfb4a942401901e9cdf1efc4847da51c692
Merge: 796514a c10828b
Author: Joakim Verona <address@hidden>
Commit: Joakim Verona <address@hidden>
Merge branch 'master' into xwidget
Conflicts:
lisp/ChangeLog
---
lisp/emacs-lisp/package.el | 868 ++++++++++++++++++++++++++------------------
lisp/net/tramp-sh.el | 22 +-
2 files changed, 521 insertions(+), 369 deletions(-)
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 88fc950..1627106 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -295,8 +295,8 @@ packages in `package-directory-list'."
(let (result)
(dolist (f load-path)
(and (stringp f)
- (equal (file-name-nondirectory f) "site-lisp")
- (push (expand-file-name "elpa" f) result)))
+ (equal (file-name-nondirectory f) "site-lisp")
+ (push (expand-file-name "elpa" f) result)))
(nreverse result))
"List of additional directories containing Emacs Lisp packages.
Each directory name should be absolute.
@@ -320,8 +320,8 @@ it is unsigned.
This also applies to the \"archive-contents\" file that lists the
contents of the archive."
:type '(choice (const nil :tag "Never")
- (const allow-unsigned :tag "Allow unsigned")
- (const t :tag "Check always"))
+ (const allow-unsigned :tag "Allow unsigned")
+ (const t :tag "Check always"))
:risky t
:group 'package
:version "24.4")
@@ -333,6 +333,17 @@ contents of the archive."
:group 'package
:version "24.4")
+(defcustom package-selected-packages nil
+ "Store here packages installed explicitely by user.
+This variable will be feeded automatically by emacs,
+when installing a new package.
+This variable will be used by `package-autoremove' to decide
+which packages are no more needed.
+You can use it to (re)install packages on other machines
+by running `package-user-selected-packages-install'."
+ :group 'package
+ :type '(repeat symbol))
+
(defvar package--default-summary "No description available.")
(cl-defstruct (package-desc
@@ -376,20 +387,20 @@ Slots:
`version' Version of the package, as a version list.
`summary' Short description of the package, typically taken from
- the first line of the file.
+ the first line of the file.
`reqs' Requirements of the package. A list of (PACKAGE
- VERSION-LIST) naming the dependent package and the minimum
- required version.
+ VERSION-LIST) naming the dependent package and the minimum
+ required version.
`kind' The distribution format of the package. Currently, it is
- either `single' or `tar'.
+ either `single' or `tar'.
`archive' The name of the archive (as a string) whence this
- package came.
+ package came.
`dir' The directory where the package is installed (if installed),
- `builtin' if it is built-in, or nil otherwise.
+ `builtin' if it is built-in, or nil otherwise.
`extras' Optional alist of additional keyword-value pairs.
@@ -466,32 +477,32 @@ This is, approximately, the inverse of `version-to-list'.
""
(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 -4)
- (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")
+ (cond
+ ((>= num 0)
+ (push (int-to-string num) str-list)
+ (push "." str-list))
+ ((< num -4)
+ (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")
((= num -4) "snapshot"))
- str-list))))
+ str-list))))
(if (equal "." (car str-list))
- (pop str-list))
+ (pop str-list))
(apply 'concat (nreverse str-list)))))
(defun package-load-descriptor (pkg-dir)
"Load the description file in directory PKG-DIR."
(let ((pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir))
- (signed-file (concat pkg-dir ".signed")))
+ (signed-file (concat pkg-dir ".signed")))
(when (file-exists-p pkg-file)
(with-temp-buffer
(insert-file-contents pkg-file)
@@ -499,8 +510,8 @@ This is, approximately, the inverse of `version-to-list'.
(let ((pkg-desc (package-process-define-package
(read (current-buffer)) pkg-file)))
(setf (package-desc-dir pkg-desc) pkg-dir)
- (if (file-exists-p signed-file)
- (setf (package-desc-signed pkg-desc) t))
+ (if (file-exists-p signed-file)
+ (setf (package-desc-signed pkg-desc) t))
pkg-desc)))))
(defun package-load-all-descriptors ()
@@ -540,11 +551,11 @@ If RELOAD is non-nil, also `load' any files inside the
package which
correspond to previously loaded files (those returned by
`package--list-loaded-files')."
(let* ((name (package-desc-name pkg-desc))
- (pkg-dir (package-desc-dir pkg-desc))
+ (pkg-dir (package-desc-dir pkg-desc))
(pkg-dir-dir (file-name-as-directory pkg-dir)))
(unless pkg-dir
(error "Internal error: unable to find directory for `%s'"
- (package-desc-full-name pkg-desc)))
+ (package-desc-full-name pkg-desc)))
;; Add to load path, add autoloads, and activate the package.
(let* ((old-lp load-path)
(autoloads-file (expand-file-name
@@ -564,7 +575,7 @@ correspond to previously loaded files (those returned by
;; depends on this new definition, not doing this update would cause
;; compilation errors and break the installation.
(with-demoted-errors "Error in package-activate-1: %s"
- (mapc (lambda (feature) (load feature nil t))
+ (mapc (lambda (feature) (load feature nil t))
;; Skip autoloads file since we already evaluated it above.
(remove (file-truename autoloads-file) loaded-files-list))))
;; Add info node.
@@ -663,12 +674,12 @@ If FORCE is true, (re-)activate it if it's already
activated."
(dolist (req (package-desc-reqs pkg-vec))
(unless (package-activate (car req))
(throw 'dep-failure req))))))
- (if fail
- (warn "Unable to activate package `%s'.
+ (if fail
+ (warn "Unable to activate package `%s'.
Required package `%s-%s' is unavailable"
- package (car fail) (package-version-join (cadr fail)))
- ;; If all goes well, activate the package itself.
- (package-activate-1 pkg-vec force)))))))
+ package (car fail) (package-version-join (cadr fail)))
+ ;; If all goes well, activate the package itself.
+ (package-activate-1 pkg-vec force)))))))
(defun define-package (_name-string _version-string
&optional _docstring _requirements
@@ -711,17 +722,17 @@ EXTRA-PROPERTIES is currently unused."
(unless (file-exists-p file)
(write-region
(concat ";;; " (file-name-nondirectory file)
- " --- automatically extracted autoloads\n"
- ";;\n"
- ";;; Code:\n"
+ " --- automatically extracted autoloads\n"
+ ";;\n"
+ ";;; Code:\n"
"(add-to-list 'load-path (or (file-name-directory #$) (car
load-path)))\n"
- " \n;; Local Variables:\n"
- ";; version-control: never\n"
- ";; no-byte-compile: t\n"
- ";; no-update-autoloads: t\n"
- ";; End:\n"
- ";;; " (file-name-nondirectory file)
- " ends here\n")
+ " \n;; Local Variables:\n"
+ ";; version-control: never\n"
+ ";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
+ ";; End:\n"
+ ";;; " (file-name-nondirectory file)
+ " ends here\n")
nil file nil 'silent))
file)
@@ -730,10 +741,10 @@ EXTRA-PROPERTIES is currently unused."
(defun package-generate-autoloads (name pkg-dir)
(let* ((auto-name (format "%s-autoloads.el" name))
- ;;(ignore-name (concat name "-pkg.el"))
- (generated-autoload-file (expand-file-name auto-name pkg-dir))
+ ;;(ignore-name (concat name "-pkg.el"))
+ (generated-autoload-file (expand-file-name auto-name pkg-dir))
(backup-inhibited t)
- (version-control 'never))
+ (version-control 'never))
(package-autoload-ensure-default-file generated-autoload-file)
(update-directory-autoloads pkg-dir)
(let ((buf (find-buffer-visiting generated-autoload-file)))
@@ -753,15 +764,15 @@ untar into a directory named DIR; otherwise, signal an
error."
(tar-mode)
;; Make sure everything extracts into DIR.
(let ((regexp (concat "\\`" (regexp-quote (expand-file-name dir)) "/"))
- (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
+ (case-fold-search (memq system-type '(windows-nt ms-dos cygwin))))
(dolist (tar-data tar-parse-info)
(let ((name (expand-file-name (tar-header-name tar-data))))
- (or (string-match regexp name)
- ;; Tarballs created by some utilities don't list
- ;; directories with a trailing slash (Bug#13136).
- (and (string-equal dir name)
- (eq (tar-header-link-type tar-data) 5))
- (error "Package does not untar cleanly into directory %s/" dir)))))
+ (or (string-match regexp name)
+ ;; Tarballs created by some utilities don't list
+ ;; directories with a trailing slash (Bug#13136).
+ (and (string-equal dir name)
+ (eq (tar-header-link-type tar-data) 5))
+ (error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
(defun package-generate-description-file (pkg-desc pkg-file)
@@ -800,7 +811,7 @@ untar into a directory named DIR; otherwise, signal an
error."
"Install the contents of the current buffer as a package."
(let* ((name (package-desc-name pkg-desc))
(dirname (package-desc-full-name pkg-desc))
- (pkg-dir (expand-file-name dirname package-user-dir)))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
(pcase (package-desc-kind pkg-desc)
(`dir
(make-directory pkg-dir t)
@@ -869,28 +880,28 @@ buffer is killed afterwards. Return the last value in
BODY."
(declare (indent 2) (debug t))
`(with-temp-buffer
(if (string-match-p "\\`https?:" ,location)
- (url-insert-file-contents (concat ,location ,file))
+ (url-insert-file-contents (concat ,location ,file))
(unless (file-name-absolute-p ,location)
- (error "Archive location %s is not an absolute file name"
- ,location))
+ (error "Archive location %s is not an absolute file name"
+ ,location))
(insert-file-contents (expand-file-name ,file ,location)))
,@body))
(defun package--archive-file-exists-p (location file)
(let ((http (string-match "\\`https?:" location)))
(if http
- (progn
- (require 'url-http)
- (url-http-file-exists-p (concat location file)))
+ (progn
+ (require 'url-http)
+ (url-http-file-exists-p (concat location file)))
(file-exists-p (expand-file-name file location)))))
(declare-function epg-make-context "epg"
- (&optional protocol armor textmode include-certs
- cipher-algorithm
- digest-algorithm
- compress-algorithm))
+ (&optional protocol armor textmode include-certs
+ cipher-algorithm
+ digest-algorithm
+ compress-algorithm))
(declare-function epg-verify-string "epg" (context signature
- &optional signed-text))
+ &optional signed-text))
(declare-function epg-context-result-for "epg" (context name))
(declare-function epg-signature-status "epg" (signature))
(declare-function epg-signature-to-string "epg" (signature))
@@ -899,13 +910,13 @@ buffer is killed afterwards. Return the last value in
BODY."
(unless (equal (epg-context-error-output context) "")
(with-output-to-temp-buffer "*Error*"
(with-current-buffer standard-output
- (if (epg-context-result-for context 'verify)
- (insert (format "Failed to verify signature %s:\n" sig-file)
- (mapconcat #'epg-signature-to-string
- (epg-context-result-for context 'verify)
- "\n"))
- (insert (format "Error while verifying signature %s:\n" sig-file)))
- (insert "\nCommand output:\n" (epg-context-error-output context))))))
+ (if (epg-context-result-for context 'verify)
+ (insert (format "Failed to verify signature %s:\n" sig-file)
+ (mapconcat #'epg-signature-to-string
+ (epg-context-result-for context 'verify)
+ "\n"))
+ (insert (format "Error while verifying signature %s:\n" sig-file)))
+ (insert "\nCommand output:\n" (epg-context-error-output context))))))
(defun package--check-signature (location file)
"Check signature of the current buffer.
@@ -914,10 +925,10 @@ GnuPG keyring is located under \"gnupg\" in
`package-user-dir'."
(homedir (expand-file-name "gnupg" package-user-dir))
(sig-file (concat file ".sig"))
(sig-content (package--with-work-buffer location sig-file
- (buffer-string))))
+ (buffer-string))))
(setf (epg-context-home-directory context) homedir)
(condition-case error
- (epg-verify-string context sig-content (buffer-string))
+ (epg-verify-string context sig-content (buffer-string))
(error
(package--display-verify-error context sig-file)
(signal (car error) (cdr error))))
@@ -925,18 +936,18 @@ GnuPG keyring is located under \"gnupg\" in
`package-user-dir'."
;; The .sig file may contain multiple signatures. Success if one
;; of the signatures is good.
(dolist (sig (epg-context-result-for context 'verify))
- (if (eq (epg-signature-status sig) 'good)
- (push sig good-signatures)
- ;; If package-check-signature is allow-unsigned, don't
- ;; signal error when we can't verify signature because of
- ;; missing public key. Other errors are still treated as
- ;; fatal (bug#17625).
- (unless (and (eq package-check-signature 'allow-unsigned)
- (eq (epg-signature-status sig) 'no-pubkey))
- (setq had-fatal-error t))))
+ (if (eq (epg-signature-status sig) 'good)
+ (push sig good-signatures)
+ ;; If package-check-signature is allow-unsigned, don't
+ ;; signal error when we can't verify signature because of
+ ;; missing public key. Other errors are still treated as
+ ;; fatal (bug#17625).
+ (unless (and (eq package-check-signature 'allow-unsigned)
+ (eq (epg-signature-status sig) 'no-pubkey))
+ (setq had-fatal-error t))))
(when (and (null good-signatures) had-fatal-error)
- (package--display-verify-error context sig-file)
- (error "Failed to verify signature %s" sig-file))
+ (package--display-verify-error context sig-file)
+ (error "Failed to verify signature %s" sig-file))
good-signatures)))
(defun package-install-from-archive (pkg-desc)
@@ -945,37 +956,37 @@ GnuPG keyring is located under \"gnupg\" in
`package-user-dir'."
(when (eq (package-desc-kind pkg-desc) 'dir)
(error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
- (file (concat (package-desc-full-name pkg-desc)
- (package-desc-suffix pkg-desc)))
- (sig-file (concat file ".sig"))
- good-signatures pkg-descs)
+ (file (concat (package-desc-full-name pkg-desc)
+ (package-desc-suffix pkg-desc)))
+ (sig-file (concat file ".sig"))
+ good-signatures pkg-descs)
(package--with-work-buffer location file
(if (and package-check-signature
- (not (member (package-desc-archive pkg-desc)
- package-unsigned-archives)))
- (if (package--archive-file-exists-p location sig-file)
- (setq good-signatures (package--check-signature location file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned package: `%s'"
- (package-desc-name pkg-desc)))))
+ (not (member (package-desc-archive pkg-desc)
+ package-unsigned-archives)))
+ (if (package--archive-file-exists-p location sig-file)
+ (setq good-signatures (package--check-signature location file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned package: `%s'"
+ (package-desc-name pkg-desc)))))
(package-unpack pkg-desc))
;; Here the package has been installed successfully, mark it as
;; signed if appropriate.
(when good-signatures
;; Write out good signatures into NAME-VERSION.signed file.
(write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name
- (concat (package-desc-full-name pkg-desc)
- ".signed")
- package-user-dir)
+ nil
+ (expand-file-name
+ (concat (package-desc-full-name pkg-desc)
+ ".signed")
+ package-user-dir)
nil 'silent)
;; Update the old pkg-desc which will be shown on the description buffer.
(setf (package-desc-signed pkg-desc) t)
;; Update the new (activated) pkg-desc as well.
(setq pkg-descs (cdr (assq (package-desc-name pkg-desc) package-alist)))
(if pkg-descs
- (setf (package-desc-signed (car pkg-descs)) t)))))
+ (setf (package-desc-signed (car pkg-descs)) t)))))
(defvar package--initialized nil)
@@ -986,8 +997,8 @@ MIN-VERSION should be a version list."
(or
(let ((pkg-descs (cdr (assq package package-alist))))
(and pkg-descs
- (version-list-<= min-version
- (package-desc-version (car pkg-descs)))))
+ (version-list-<= min-version
+ (package-desc-version (car pkg-descs)))))
;; Also check built-in packages.
(package-built-in-p package min-version)))
@@ -1013,7 +1024,7 @@ SEEN is used internally to detect infinite recursion."
;; older bar-1.3).
(dolist (elt requirements)
(let* ((next-pkg (car elt))
- (next-version (cadr elt))
+ (next-version (cadr elt))
(already ()))
(dolist (pkg packages)
(if (eq next-pkg (package-desc-name pkg))
@@ -1037,9 +1048,9 @@ SEEN is used internally to detect infinite recursion."
((package-installed-p next-pkg next-version) nil)
(t
- ;; A package is required, but not installed. It might also be
- ;; blocked via `package-load-list'.
- (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
+ ;; A package is required, but not installed. It might also be
+ ;; blocked via `package-load-list'.
+ (let ((pkg-descs (cdr (assq next-pkg package-archive-contents)))
(found nil)
(problem nil))
(while (and pkg-descs (not found))
@@ -1063,14 +1074,14 @@ but version %s required"
(format "Required package '%s' is disabled"
next-pkg)))))
(t (setq found pkg-desc)))))
- (unless found
+ (unless found
(if problem
(error "%s" problem)
(error "Package `%s-%s' is unavailable"
next-pkg (package-version-join next-version))))
- (setq packages
- (package-compute-transaction (cons found packages)
- (package-desc-reqs found)
+ (setq packages
+ (package-compute-transaction (cons found packages)
+ (package-desc-reqs found)
(cons found seen))))))))
packages)
@@ -1078,13 +1089,13 @@ but version %s required"
"Read a Lisp expression from STR.
Signal an error if the entire string was not used."
(let* ((read-data (read-from-string str))
- (more-left
- (condition-case nil
- ;; The call to `ignore' suppresses a compiler warning.
- (progn (ignore (read-from-string
- (substring str (cdr read-data))))
- t)
- (end-of-file nil))))
+ (more-left
+ (condition-case nil
+ ;; The call to `ignore' suppresses a compiler warning.
+ (progn (ignore (read-from-string
+ (substring str (cdr read-data))))
+ t)
+ (end-of-file nil))))
(if more-left
(error "Can't read whole string")
(car read-data))))
@@ -1096,12 +1107,12 @@ Will throw an error if the archive version is too new."
(let ((filename (expand-file-name file package-user-dir)))
(when (file-exists-p filename)
(with-temp-buffer
- (insert-file-contents-literally filename)
- (let ((contents (read (current-buffer))))
- (if (> (car contents) package-archive-version)
- (error "Package archive version %d is higher than %d"
- (car contents) package-archive-version))
- (cdr contents))))))
+ (insert-file-contents-literally filename)
+ (let ((contents (read (current-buffer))))
+ (if (> (car contents) package-archive-version)
+ (error "Package archive version %d is higher than %d"
+ (car contents) package-archive-version))
+ (cdr contents))))))
(defun package-read-all-archive-contents ()
"Re-read `archive-contents', if it exists.
@@ -1117,10 +1128,10 @@ If the archive version is too new, signal an error."
;; Version 1 of 'archive-contents' is identical to our internal
;; representation.
(let* ((contents-file (format "archives/%s/archive-contents" archive))
- (contents (package--read-archive-file contents-file)))
+ (contents (package--read-archive-file contents-file)))
(when contents
(dolist (package contents)
- (package--add-to-archive-contents package archive)))))
+ (package--add-to-archive-contents package archive)))))
;; Package descriptor objects used inside the "archive-contents" file.
;; Changing this defstruct implies changing the format of the
@@ -1187,10 +1198,13 @@ using `package-compute-transaction'."
(mapc #'package-install-from-archive packages))
;;;###autoload
-(defun package-install (pkg)
+(defun package-install (pkg &optional mark-selected)
"Install the package PKG.
PKG can be a package-desc or the package name of one the available packages
-in an archive in `package-archives'. Interactively, prompt for its name."
+in an archive in `package-archives'. Interactively, prompt for its name.
+
+If called interactively or if MARK-SELECTED is non-nil, add PKG
+to `package-selected-packages'."
(interactive
(progn
;; Initialize the package system to get the list of package
@@ -1206,7 +1220,11 @@ in an archive in `package-archives'. Interactively,
prompt for its name."
(unless (package-installed-p (car elt))
(symbol-name (car elt))))
package-archive-contents))
- nil t)))))
+ nil t))
+ t)))
+ (when (and mark-selected (not (memq pkg package-selected-packages)))
+ (customize-save-variable 'package-selected-packages
+ (cons pkg package-selected-packages)))
(package-download-transaction
(if (package-desc-p pkg)
(package-compute-transaction (list pkg)
@@ -1214,6 +1232,16 @@ in an archive in `package-archives'. Interactively,
prompt for its name."
(package-compute-transaction ()
(list (list pkg))))))
+;;;###autoload
+(defun package-reinstall (pkg)
+ "Reinstall package PKG."
+ (interactive (list (intern (completing-read
+ "Reinstall package: "
+ (mapcar #'symbol-name
+ (mapcar #'car package-alist))))))
+ (package-delete (cadr (assq pkg package-alist)) t)
+ (package-install pkg))
+
(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.
@@ -1222,8 +1250,8 @@ Otherwise return nil."
(when (string-match "\\`[ \t]*[$]Revision:[ \t]+" str)
(setq str (substring str (match-end 0))))
(condition-case nil
- (if (version-to-list str)
- str)
+ (if (version-to-list str)
+ str)
(error nil))))
(declare-function lm-homepage "lisp-mnt" (&optional file))
@@ -1257,8 +1285,8 @@ boundaries."
(unless (re-search-forward "^;;; \\([^ ]*\\)\\.el ---[ \t]*\\(.*?\\)[
\t]*\\(-\\*-.*-\\*-[ \t]*\\)?$" nil t)
(error "Package lacks a file header"))
(let ((file-name (match-string-no-properties 1))
- (desc (match-string-no-properties 2))
- (start (line-beginning-position)))
+ (desc (match-string-no-properties 2))
+ (start (line-beginning-position)))
(unless (search-forward (concat ";;; " file-name ".el ends here"))
(error "Package lacks a terminating comment"))
;; Try to include a trailing newline.
@@ -1267,15 +1295,15 @@ boundaries."
(require 'lisp-mnt)
;; Use some headers we've invented to drive the process.
(let* ((requires-str (lm-header "package-requires"))
- ;; Prefer Package-Version; if defined, the package author
- ;; probably wants us to use it. Otherwise try Version.
- (pkg-version
- (or (package-strip-rcs-id (lm-header "package-version"))
- (package-strip-rcs-id (lm-header "version"))))
+ ;; Prefer Package-Version; if defined, the package author
+ ;; probably wants us to use it. Otherwise try Version.
+ (pkg-version
+ (or (package-strip-rcs-id (lm-header "package-version"))
+ (package-strip-rcs-id (lm-header "version"))))
(homepage (lm-homepage)))
(unless pkg-version
- (error
- "Package lacks a \"Version\" or \"Package-Version\" header"))
+ (error
+ "Package lacks a \"Version\" or \"Package-Version\" header"))
(package-desc-from-define
file-name pkg-version desc
(if requires-str
@@ -1354,24 +1382,29 @@ is derived from the main .el file in the directory.
Downloads and installs required packages as needed."
(interactive)
- (let ((pkg-desc
- (cond
- ((derived-mode-p 'dired-mode)
- ;; This is the only way a package-desc object with a `dir'
- ;; desc-kind can be created. Such packages can't be
- ;; uploaded or installed from archives, they can only be
- ;; installed from local buffers or directories.
- (package-dir-info))
- ((derived-mode-p 'tar-mode)
- (package-tar-file-info))
- (t
- (package-buffer-info)))))
+ (let* ((pkg-desc
+ (cond
+ ((derived-mode-p 'dired-mode)
+ ;; This is the only way a package-desc object with a `dir'
+ ;; desc-kind can be created. Such packages can't be
+ ;; uploaded or installed from archives, they can only be
+ ;; installed from local buffers or directories.
+ (package-dir-info))
+ ((derived-mode-p 'tar-mode)
+ (package-tar-file-info))
+ (t
+ (package-buffer-info))))
+ (name (package-desc-name pkg-desc)))
;; Download and install the dependencies.
(let* ((requires (package-desc-reqs pkg-desc))
(transaction (package-compute-transaction nil requires)))
(package-download-transaction transaction))
;; Install the package itself.
(package-unpack pkg-desc)
+ (unless (memq name package-selected-packages)
+ (push name package-selected-packages)
+ (customize-save-variable 'package-selected-packages
+ package-selected-packages))
pkg-desc))
;;;###autoload
@@ -1388,26 +1421,119 @@ The file can either be a tar file or an Emacs Lisp
file."
(when (string-match "\\.tar\\'" file) (tar-mode)))
(package-install-from-buffer)))
-(defun package-delete (pkg-desc)
- (let ((dir (package-desc-dir pkg-desc)))
- (if (not (string-prefix-p (file-name-as-directory
- (expand-file-name package-user-dir))
- (expand-file-name dir)))
- ;; Don't delete "system" packages.
- (error "Package `%s' is a system package, not deleting"
- (package-desc-full-name pkg-desc))
- (delete-directory dir t t)
- ;; Remove NAME-VERSION.signed file.
- (let ((signed-file (concat dir ".signed")))
- (if (file-exists-p signed-file)
- (delete-file signed-file)))
- ;; Update package-alist.
- (let* ((name (package-desc-name pkg-desc))
- (pkgs (assq name package-alist)))
- (delete pkg-desc pkgs)
- (unless (cdr pkgs)
- (setq package-alist (delq pkgs package-alist))))
- (message "Package `%s' deleted." (package-desc-full-name pkg-desc)))))
+(defun package--get-deps (pkg &optional only)
+ (let* ((pkg-desc (cadr (assq pkg package-alist)))
+ (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc)
+ for name = (car p)
+ when (assq name package-alist)
+ collect name))
+ (indirect-deps (unless (eq only 'direct)
+ (delete-dups
+ (cl-loop for p in direct-deps
+ append (package--get-deps p))))))
+ (cl-case only
+ (direct direct-deps)
+ (separate (list direct-deps indirect-deps))
+ (indirect indirect-deps)
+ (t (append direct-deps indirect-deps)))))
+
+;;;###autoload
+(defun package-install-user-selected-packages ()
+ "Ensure packages in `package-selected-packages' are installed.
+If some packages are not installed propose to install them."
+ (interactive)
+ (cl-loop for p in package-selected-packages
+ unless (package-installed-p p)
+ collect p into lst
+ finally
+ (if lst
+ (when (y-or-n-p
+ (format "%s packages will be installed:\n%s, proceed?"
+ (length lst)
+ (mapconcat #'symbol-name lst ", ")))
+ (mapc #'package-install lst))
+ (message "All your packages are already installed"))))
+
+(defun package--used-elsewhere-p (pkg-desc &optional pkg-list)
+ "Non-nil if PKG-DESC is a dependency of a package in PKG-LIST.
+Return the first package found in PKG-LIST of which PKG is a
+dependency.
+
+When not specified, PKG-LIST defaults to `package-alist'
+with PKG-DESC entry removed."
+ (unless (string= (package-desc-status pkg-desc) "obsolete")
+ (let ((pkg (package-desc-name pkg-desc)))
+ (cl-loop with alist = (or pkg-list
+ (remove (assq pkg package-alist)
+ package-alist))
+ for p in alist thereis
+ (and (memq pkg (mapcar #'car (package-desc-reqs (cadr p))))
+ (car p))))))
+
+(defun package-delete (pkg-desc &optional force)
+ "Delete package PKG-DESC.
+
+Argument PKG-DESC is a full description of package as vector.
+When package is used elsewhere as dependency of another package,
+refuse deleting it and return an error.
+If FORCE is non--nil package will be deleted even if it is used
+elsewhere."
+ (let ((dir (package-desc-dir pkg-desc))
+ (name (package-desc-name pkg-desc))
+ pkg-used-elsewhere-by)
+ (cond ((not (string-prefix-p (file-name-as-directory
+ (expand-file-name package-user-dir))
+ (expand-file-name dir)))
+ ;; Don't delete "system" packages.
+ (error "Package `%s' is a system package, not deleting"
+ (package-desc-full-name pkg-desc)))
+ ((and (null force)
+ (setq pkg-used-elsewhere-by
+ (package--used-elsewhere-p pkg-desc)))
+ ;; Don't delete packages used as dependency elsewhere.
+ (error "Package `%s' is used by `%s' as dependency, not deleting"
+ (package-desc-full-name pkg-desc)
+ pkg-used-elsewhere-by))
+ (t
+ (delete-directory dir t t)
+ ;; Remove NAME-VERSION.signed file.
+ (let ((signed-file (concat dir ".signed")))
+ (if (file-exists-p signed-file)
+ (delete-file signed-file)))
+ ;; Update package-alist.
+ (let ((pkgs (assq name package-alist)))
+ (delete pkg-desc pkgs)
+ (unless (cdr pkgs)
+ (setq package-alist (delq pkgs package-alist))))
+ ;; Update package-selected-packages.
+ (when (memq name package-selected-packages)
+ (customize-save-variable
+ 'package-selected-packages (remove name
package-selected-packages)))
+ (message "Package `%s' deleted." (package-desc-full-name
pkg-desc))))))
+
+;;;###autoload
+(defun package-autoremove ()
+ "Remove packages that are no more needed.
+
+Packages that are no more needed by other packages in
+`package-selected-packages' and their dependencies
+will be deleted."
+ (interactive)
+ (let ((needed (cl-loop for p in package-selected-packages
+ if (assq p package-alist)
+ append (package--get-deps p))))
+ (cl-loop for p in (mapcar #'car package-alist)
+ unless (or (memq p needed)
+ (memq p package-selected-packages))
+ collect p into lst
+ finally (if lst
+ (when (y-or-n-p (format "%s packages will be
deleted:\n%s, proceed? "
+ (length lst)
+ (mapconcat #'symbol-name lst
", ")))
+ (mapc (lambda (p)
+ (package-delete (cadr (assq p
package-alist)) t))
+ lst))
+ (message "Nothing to autoremove")))))
(defun package-archive-base (desc)
"Return the archive containing the package NAME."
@@ -1438,33 +1564,33 @@ ARCHIVE should be a cons cell of the form (NAME .
LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/archive-contents\" in `package-user-dir'."
(let ((dir (expand-file-name (format "archives/%s" (car archive))
- package-user-dir))
- (sig-file (concat file ".sig"))
- good-signatures)
+ package-user-dir))
+ (sig-file (concat file ".sig"))
+ good-signatures)
(package--with-work-buffer (cdr archive) file
;; Check signature of archive-contents, if desired.
(if (and package-check-signature
- (not (member archive package-unsigned-archives)))
- (if (package--archive-file-exists-p (cdr archive) sig-file)
- (setq good-signatures (package--check-signature (cdr archive)
- file))
- (unless (eq package-check-signature 'allow-unsigned)
- (error "Unsigned archive `%s'"
- (car archive)))))
+ (not (member archive package-unsigned-archives)))
+ (if (package--archive-file-exists-p (cdr archive) sig-file)
+ (setq good-signatures (package--check-signature (cdr archive)
+ file))
+ (unless (eq package-check-signature 'allow-unsigned)
+ (error "Unsigned archive `%s'"
+ (car archive)))))
;; Read the retrieved buffer to make sure it is valid (e.g. it
;; may fetch a URL redirect page).
(when (listp (read (current-buffer)))
- (make-directory dir t)
+ (make-directory dir t)
(write-region nil nil (expand-file-name file dir) nil 'silent)))
(when good-signatures
;; Write out good signatures into archive-contents.signed file.
(write-region (mapconcat #'epg-signature-to-string good-signatures "\n")
- nil
- (expand-file-name (concat file ".signed") dir)
+ nil
+ (expand-file-name (concat file ".signed") dir)
nil 'silent))))
(declare-function epg-check-configuration "epg-config"
- (config &optional minimum-version))
+ (config &optional minimum-version))
(declare-function epg-configuration "epg-config" ())
(declare-function epg-import-keys-from-file "epg" (context keys))
@@ -1474,7 +1600,7 @@ similar to an entry in `package-alist'. Save the cached
copy to
(interactive "fFile: ")
(setq file (expand-file-name file))
(let ((context (epg-make-context 'OpenPGP))
- (homedir (expand-file-name "gnupg" package-user-dir)))
+ (homedir (expand-file-name "gnupg" package-user-dir)))
(with-file-modes 448
(make-directory homedir t))
(setf (epg-context-home-directory context) homedir)
@@ -1492,20 +1618,35 @@ makes them available for download."
(unless (file-exists-p package-user-dir)
(make-directory package-user-dir t))
(let ((default-keyring (expand-file-name "package-keyring.gpg"
- data-directory)))
+ data-directory)))
(when (and package-check-signature (file-exists-p default-keyring))
(condition-case-unless-debug error
- (progn
- (epg-check-configuration (epg-configuration))
- (package-import-keyring default-keyring))
- (error (message "Cannot import default keyring: %S" (cdr error))))))
+ (progn
+ (epg-check-configuration (epg-configuration))
+ (package-import-keyring default-keyring))
+ (error (message "Cannot import default keyring: %S" (cdr error))))))
(dolist (archive package-archives)
(condition-case-unless-debug nil
- (package--download-one-archive archive "archive-contents")
+ (package--download-one-archive archive "archive-contents")
(error (message "Failed to download `%s' archive."
- (car archive)))))
+ (car archive)))))
(package-read-all-archive-contents))
+(defun package--find-non-dependencies ()
+ "Return a list of installed packages which are not dependencies.
+Finds all packages in `package-alist' which are not dependencies
+of any other packages.
+Used to populate `package-selected-packages'."
+ (let ((dep-list
+ (delete-dups
+ (apply #'append
+ (mapcar (lambda (p) (mapcar #'car (package-desc-reqs (cadr
p))))
+ package-alist)))))
+ (cl-loop for p in package-alist
+ for name = (car p)
+ unless (memq name dep-list)
+ collect name)))
+
;;;###autoload
(defun package-initialize (&optional no-activate)
"Load Emacs Lisp packages, and activate them.
@@ -1518,6 +1659,9 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(unless no-activate
(dolist (elt package-alist)
(package-activate (car elt))))
+ (when (and package-alist (not package-selected-packages))
+ (customize-save-variable 'package-selected-packages
+ (package--find-non-dependencies)))
(setq package--initialized t))
@@ -1548,10 +1692,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(if (not (or (package-desc-p package) (and package (symbolp package))))
(message "No package specified")
(help-setup-xref (list #'describe-package package)
- (called-interactively-p 'interactive))
+ (called-interactively-p 'interactive))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (describe-package-1 package)))))
+ (describe-package-1 package)))))
(defun describe-package-1 (pkg)
(require 'lisp-mnt)
@@ -1582,64 +1726,64 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
(cond (built-in
- (insert (propertize (capitalize status)
+ (insert (propertize (capitalize status)
'font-lock-face 'font-lock-builtin-face)
"."))
- (pkg-dir
- (insert (propertize (if (equal status "unsigned")
- "Installed"
- (capitalize status)) ;FIXME: Why comment-face?
- 'font-lock-face 'font-lock-comment-face))
- (insert " in `")
- ;; Todo: Add button for uninstalling.
- (help-insert-xref-button (abbreviate-file-name
+ (pkg-dir
+ (insert (propertize (if (equal status "unsigned")
+ "Installed"
+ (capitalize status)) ;FIXME: Why comment-face?
+ 'font-lock-face 'font-lock-comment-face))
+ (insert " in `")
+ ;; Todo: Add button for uninstalling.
+ (help-insert-xref-button (abbreviate-file-name
(file-name-as-directory pkg-dir))
- 'help-package-def pkg-dir)
- (if (and (package-built-in-p name)
+ 'help-package-def pkg-dir)
+ (if (and (package-built-in-p name)
(not (package-built-in-p name version)))
- (insert "',\n shadowing a "
- (propertize "built-in package"
- 'font-lock-face 'font-lock-builtin-face))
- (insert "'"))
- (if signed
- (insert ".")
- (insert " (unsigned).")))
- (installable
+ (insert "',\n shadowing a "
+ (propertize "built-in package"
+ 'font-lock-face 'font-lock-builtin-face))
+ (insert "'"))
+ (if signed
+ (insert ".")
+ (insert " (unsigned).")))
+ (installable
(insert (capitalize status))
- (insert " from " (format "%s" archive))
- (insert " -- ")
+ (insert " from " (format "%s" archive))
+ (insert " -- ")
(package-make-button
"Install"
'action 'package-install-button-action
'package-desc desc))
- (t (insert (capitalize status) ".")))
+ (t (insert (capitalize status) ".")))
(insert "\n")
(insert " " (propertize "Archive" 'font-lock-face 'bold)
- ": " (or archive "n/a") "\n")
+ ": " (or archive "n/a") "\n")
(and version
- (insert " "
- (propertize "Version" 'font-lock-face 'bold) ": "
+ (insert " "
+ (propertize "Version" 'font-lock-face 'bold) ": "
(package-version-join version) "\n"))
(setq reqs (if desc (package-desc-reqs desc)))
(when reqs
(insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
(let ((first t)
- name vers text)
- (dolist (req reqs)
- (setq name (car req)
- vers (cadr req)
- text (format "%s-%s" (symbol-name name)
- (package-version-join vers)))
- (cond (first (setq first nil))
- ((>= (+ 2 (current-column) (length text))
- (window-width))
- (insert ",\n "))
- (t (insert ", ")))
- (help-insert-xref-button text 'help-package name))
- (insert "\n")))
+ name vers text)
+ (dolist (req reqs)
+ (setq name (car req)
+ vers (cadr req)
+ text (format "%s-%s" (symbol-name name)
+ (package-version-join vers)))
+ (cond (first (setq first nil))
+ ((>= (+ 2 (current-column) (length text))
+ (window-width))
+ (insert ",\n "))
+ (t (insert ", ")))
+ (help-insert-xref-button text 'help-package name))
+ (insert "\n")))
(insert " " (propertize "Summary" 'font-lock-face 'bold)
- ": " (if desc (package-desc-summary desc)) "\n")
+ ": " (if desc (package-desc-summary desc)) "\n")
(when homepage
(insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ")
(help-insert-xref-button homepage 'help-url homepage)
@@ -1681,23 +1825,23 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(insert "\n")
(if built-in
- ;; For built-in packages, insert the commentary.
- (let ((fn (locate-file (format "%s.el" name) load-path
- load-file-rep-suffixes))
- (opoint (point)))
- (insert (or (lm-commentary fn) ""))
- (save-excursion
- (goto-char opoint)
- (when (re-search-forward "^;;; Commentary:\n" nil t)
- (replace-match ""))
- (while (re-search-forward "^\\(;+ ?\\)" nil t)
- (replace-match ""))))
+ ;; For built-in packages, insert the commentary.
+ (let ((fn (locate-file (format "%s.el" name) load-path
+ load-file-rep-suffixes))
+ (opoint (point)))
+ (insert (or (lm-commentary fn) ""))
+ (save-excursion
+ (goto-char opoint)
+ (when (re-search-forward "^;;; Commentary:\n" nil t)
+ (replace-match ""))
+ (while (re-search-forward "^\\(;+ ?\\)" nil t)
+ (replace-match ""))))
(let ((readme (expand-file-name (format "%s-readme.txt" name)
- package-user-dir))
- readme-string)
- ;; For elpa packages, try downloading the commentary. If that
- ;; fails, try an existing readme file in `package-user-dir'.
- (cond ((condition-case nil
+ package-user-dir))
+ readme-string)
+ ;; For elpa packages, try downloading the commentary. If that
+ ;; fails, try an existing readme file in `package-user-dir'.
+ (cond ((condition-case nil
(save-excursion
(package--with-work-buffer
(package-archive-base desc)
@@ -1711,17 +1855,17 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
nil 'silent)
(setq readme-string (buffer-string))
t))
- (error nil))
- (insert readme-string))
- ((file-readable-p readme)
- (insert-file-contents readme)
- (goto-char (point-max))))))))
+ (error nil))
+ (insert readme-string))
+ ((file-readable-p readme)
+ (insert-file-contents readme)
+ (goto-char (point-max))))))))
(defun package-install-button-action (button)
(let ((pkg-desc (button-get button 'package-desc)))
(when (y-or-n-p (format "Install package `%s'? "
(package-desc-full-name pkg-desc)))
- (package-install pkg-desc)
+ (package-install pkg-desc 1)
(revert-buffer nil t)
(goto-char (point-min)))))
@@ -1744,7 +1888,7 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(defvar package-menu-mode-map
(let ((map (make-sparse-keymap))
- (menu-map (make-sparse-keymap "Package")))
+ (menu-map (make-sparse-keymap "Package")))
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "\C-m" 'package-menu-describe-package)
(define-key map "u" 'package-menu-mark-unmark)
@@ -1761,54 +1905,54 @@ If optional arg NO-ACTIVATE is non-nil, don't activate
packages."
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq]
'(menu-item "Quit" quit-window
- :help "Quit package selection"))
+ :help "Quit package selection"))
(define-key menu-map [s1] '("--"))
(define-key menu-map [mn]
'(menu-item "Next" next-line
- :help "Next Line"))
+ :help "Next Line"))
(define-key menu-map [mp]
'(menu-item "Previous" previous-line
- :help "Previous Line"))
+ :help "Previous Line"))
(define-key menu-map [s2] '("--"))
(define-key menu-map [mu]
'(menu-item "Unmark" package-menu-mark-unmark
- :help "Clear any marks on a package and move to the next
line"))
+ :help "Clear any marks on a package and move to the next
line"))
(define-key menu-map [munm]
'(menu-item "Unmark Backwards" package-menu-backup-unmark
- :help "Back up one line and clear any marks on that package"))
+ :help "Back up one line and clear any marks on that
package"))
(define-key menu-map [md]
'(menu-item "Mark for Deletion" package-menu-mark-delete
- :help "Mark a package for deletion and move to the next
line"))
+ :help "Mark a package for deletion and move to the next
line"))
(define-key menu-map [mi]
'(menu-item "Mark for Install" package-menu-mark-install
- :help "Mark a package for installation and move to the next
line"))
+ :help "Mark a package for installation and move to the next
line"))
(define-key menu-map [mupgrades]
'(menu-item "Mark Upgradable Packages" package-menu-mark-upgrades
- :help "Mark packages that have a newer version for
upgrading"))
+ :help "Mark packages that have a newer version for
upgrading"))
(define-key menu-map [s3] '("--"))
(define-key menu-map [mf]
'(menu-item "Filter Package List..." package-menu-filter
- :help "Filter package selection (q to go back)"))
+ :help "Filter package selection (q to go back)"))
(define-key menu-map [mg]
'(menu-item "Update Package List" revert-buffer
- :help "Update the list of packages"))
+ :help "Update the list of packages"))
(define-key menu-map [mr]
'(menu-item "Refresh Package List" package-menu-refresh
- :help "Download the ELPA archive"))
+ :help "Download the ELPA archive"))
(define-key menu-map [s4] '("--"))
(define-key menu-map [mt]
'(menu-item "Mark Obsolete Packages"
package-menu-mark-obsolete-for-deletion
- :help "Mark all obsolete packages for deletion"))
+ :help "Mark all obsolete packages for deletion"))
(define-key menu-map [mx]
'(menu-item "Execute Actions" package-menu-execute
- :help "Perform all the marked actions"))
+ :help "Perform all the marked actions"))
(define-key menu-map [s5] '("--"))
(define-key menu-map [mh]
'(menu-item "Help" package-menu-quick-help
- :help "Show short key binding help for package-menu-mode"))
+ :help "Show short key binding help for package-menu-mode"))
(define-key menu-map [mc]
'(menu-item "Describe Package" package-menu-describe-package
- :help "Display information about this package"))
+ :help "Display information about this package"))
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -1903,8 +2047,8 @@ KEYWORDS should be nil or a list of keywords."
(package--has-keyword-p (package--from-builtin elt) keywords)
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
- (package--push (package--from-builtin elt) "built-in" info-list)))
+ (or (eq packages t) (memq name packages)))
+ (package--push (package--from-builtin elt) "built-in" info-list)))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
@@ -1949,7 +2093,7 @@ Built-in packages are converted with
`package--from-builtin'."
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or package-list-unversioned
(package--bi-desc-version (cdr elt)))
- (or (eq packages t) (memq name packages)))
+ (or (eq packages t) (memq name packages)))
(funcall function (package--from-builtin elt))))
;; Available and disabled packages:
@@ -2000,8 +2144,8 @@ shown."
PKG has the form (PKG-DESC . STATUS).
Return (PKG-DESC [NAME VERSION STATUS DOC])."
(let* ((pkg-desc (car pkg))
- (status (cdr pkg))
- (face (pcase status
+ (status (cdr pkg))
+ (face (pcase status
(`"built-in" 'font-lock-builtin-face)
(`"available" 'default)
(`"new" 'bold)
@@ -2011,7 +2155,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
(`"unsigned" 'font-lock-warning-face)
(_ 'font-lock-warning-face)))) ; obsolete.
(list pkg-desc
- `[,(list (symbol-name (package-desc-name pkg-desc))
+ `[,(list (symbol-name (package-desc-name pkg-desc))
'face 'link
'follow-link t
'package-desc pkg-desc
@@ -2041,9 +2185,9 @@ This fetches the contents of each archive specified in
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
(let ((pkg-desc (if button (button-get button 'package-desc)
- (tabulated-list-get-id))))
+ (tabulated-list-get-id))))
(if pkg-desc
- (describe-package pkg-desc)
+ (describe-package pkg-desc)
(user-error "No package here"))))
;; fixme numeric argument
@@ -2079,8 +2223,8 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(goto-char (point-min))
(while (not (eobp))
(if (equal (package-menu-get-status) "obsolete")
- (tabulated-list-put-tag "D" t)
- (forward-line 1)))))
+ (tabulated-list-put-tag "D" t)
+ (forward-line 1)))))
(defun package-menu-quick-help ()
"Show short key binding help for package-menu-mode."
@@ -2092,9 +2236,9 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(defun package-menu-get-status ()
(let* ((id (tabulated-list-get-id))
- (entry (and id (assq id tabulated-list-entries))))
+ (entry (and id (assq id tabulated-list-entries))))
(if entry
- (aref (cadr entry) 2)
+ (aref (cadr entry) 2)
"")))
(defun package-menu--find-upgrades ()
@@ -2103,7 +2247,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(dolist (entry tabulated-list-entries)
;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC])
(let ((pkg-desc (car entry))
- (status (aref (cadr entry) 2)))
+ (status (aref (cadr entry) 2)))
(cond ((member status '("installed" "unsigned"))
(push pkg-desc installed))
((member status '("available" "new"))
@@ -2129,22 +2273,22 @@ call will upgrade the package."
(error "The current buffer is not a Package Menu"))
(let ((upgrades (package-menu--find-upgrades)))
(if (null upgrades)
- (message "No packages to upgrade.")
+ (message "No packages to upgrade.")
(widen)
(save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pkg-desc (tabulated-list-get-id))
- (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
- (cond ((null upgrade)
- (forward-line 1))
- ((equal pkg-desc upgrade)
- (package-menu-mark-install))
- (t
- (package-menu-mark-delete))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((pkg-desc (tabulated-list-get-id))
+ (upgrade (cdr (assq (package-desc-name pkg-desc) upgrades))))
+ (cond ((null upgrade)
+ (forward-line 1))
+ ((equal pkg-desc upgrade)
+ (package-menu-mark-install))
+ (t
+ (package-menu-mark-delete))))))
(message "%d package%s marked for upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")))))
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")))))
(defun package-menu-execute (&optional noquery)
"Perform marked Package Menu actions.
@@ -2158,15 +2302,15 @@ Optional argument NOQUERY non-nil means do not ask the
user to confirm."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
- (setq cmd (char-after))
- (unless (eq cmd ?\s)
- ;; This is the key PKG-DESC.
- (setq pkg-desc (tabulated-list-get-id))
- (cond ((eq cmd ?D)
- (push pkg-desc delete-list))
- ((eq cmd ?I)
- (push pkg-desc install-list))))
- (forward-line)))
+ (setq cmd (char-after))
+ (unless (eq cmd ?\s)
+ ;; This is the key PKG-DESC.
+ (setq pkg-desc (tabulated-list-get-id))
+ (cond ((eq cmd ?D)
+ (push pkg-desc delete-list))
+ ((eq cmd ?I)
+ (push pkg-desc install-list))))
+ (forward-line)))
(when install-list
(if (or
noquery
@@ -2178,70 +2322,72 @@ Optional argument NOQUERY non-nil means do not ask the
user to confirm."
(length install-list)
(mapconcat #'package-desc-full-name
install-list ", ")))))
- (mapc 'package-install install-list)))
+ (mapc (lambda (p)
+ (package-install p (null (package-installed-p p))))
+ install-list)))
;; Delete packages, prompting if necessary.
(when delete-list
(if (or
noquery
(yes-or-no-p
- (if (= (length delete-list) 1)
- (format "Delete package `%s'? "
+ (if (= (length delete-list) 1)
+ (format "Delete package `%s'? "
(package-desc-full-name (car delete-list)))
- (format "Delete these %d packages (%s)? "
- (length delete-list)
- (mapconcat #'package-desc-full-name
- delete-list ", ")))))
- (dolist (elt delete-list)
- (condition-case-unless-debug err
- (package-delete elt)
- (error (message (cadr err)))))
- (error "Aborted")))
+ (format "Delete these %d packages (%s)? "
+ (length delete-list)
+ (mapconcat #'package-desc-full-name
+ delete-list ", ")))))
+ (dolist (elt delete-list)
+ (condition-case-unless-debug err
+ (package-delete elt)
+ (error (message (cadr err)))))
+ (error "Aborted")))
(if (or delete-list install-list)
- (package-menu--generate t t)
+ (package-menu--generate t t)
(message "No operations specified."))))
(defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0)))
- (vB (or (aref (cadr B) 1) '(0))))
+ (vB (or (aref (cadr B) 1) '(0))))
(if (version-list-= vA vB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(version-list-< vA vB))))
(defun package-menu--status-predicate (A B)
(let ((sA (aref (cadr A) 2))
- (sB (aref (cadr B) 2)))
+ (sB (aref (cadr B) 2)))
(cond ((string= sA sB)
- (package-menu--name-predicate A B))
- ((string= sA "new") t)
- ((string= sB "new") nil)
- ((string= sA "available") t)
- ((string= sB "available") nil)
- ((string= sA "installed") t)
- ((string= sB "installed") nil)
- ((string= sA "unsigned") t)
- ((string= sB "unsigned") nil)
- ((string= sA "held") t)
- ((string= sB "held") nil)
- ((string= sA "built-in") t)
- ((string= sB "built-in") nil)
- ((string= sA "obsolete") t)
- ((string= sB "obsolete") nil)
- (t (string< sA sB)))))
+ (package-menu--name-predicate A B))
+ ((string= sA "new") t)
+ ((string= sB "new") nil)
+ ((string= sA "available") t)
+ ((string= sB "available") nil)
+ ((string= sA "installed") t)
+ ((string= sB "installed") nil)
+ ((string= sA "unsigned") t)
+ ((string= sB "unsigned") nil)
+ ((string= sA "held") t)
+ ((string= sB "held") nil)
+ ((string= sA "built-in") t)
+ ((string= sB "built-in") nil)
+ ((string= sA "obsolete") t)
+ ((string= sB "obsolete") nil)
+ (t (string< sA sB)))))
(defun package-menu--description-predicate (A B)
(let ((dA (aref (cadr A) 3))
- (dB (aref (cadr B) 3)))
+ (dB (aref (cadr B) 3)))
(if (string= dA dB)
- (package-menu--name-predicate A B)
+ (package-menu--name-predicate A B)
(string< dA dB))))
(defun package-menu--name-predicate (A B)
(string< (symbol-name (package-desc-name (car A)))
- (symbol-name (package-desc-name (car B)))))
+ (symbol-name (package-desc-name (car B)))))
(defun package-menu--archive-predicate (A B)
(string< (or (package-desc-archive (car A)) "")
- (or (package-desc-archive (car B)) "")))
+ (or (package-desc-archive (car B)) "")))
;;;###autoload
(defun list-packages (&optional no-fetch)
@@ -2263,27 +2409,27 @@ The list is displayed in a buffer named `*Packages*'."
(package-refresh-contents)
;; Find which packages are new.
(dolist (elt package-archive-contents)
- (unless (assq (car elt) old-archives)
- (push (car elt) new-packages))))
+ (unless (assq (car elt) old-archives)
+ (push (car elt) new-packages))))
;; Generate the Package Menu.
(let ((buf (get-buffer-create "*Packages*")))
(with-current-buffer buf
- (package-menu-mode)
- (set (make-local-variable 'package-menu--new-package-list)
- new-packages)
- (package-menu--generate nil t))
+ (package-menu-mode)
+ (set (make-local-variable 'package-menu--new-package-list)
+ new-packages)
+ (package-menu--generate nil t))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf))
(let ((upgrades (package-menu--find-upgrades)))
(if upgrades
- (message "%d package%s can be upgraded; type `%s' to mark %s for
upgrading."
- (length upgrades)
- (if (= (length upgrades) 1) "" "s")
- (substitute-command-keys "\\[package-menu-mark-upgrades]")
- (if (= (length upgrades) 1) "it" "them"))))))
+ (message "%d package%s can be upgraded; type `%s' to mark %s for
upgrading."
+ (length upgrades)
+ (if (= (length upgrades) 1) "" "s")
+ (substitute-command-keys "\\[package-menu-mark-upgrades]")
+ (if (= (length upgrades) 1) "it" "them"))))))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 80a256c..8e519b1 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -65,19 +65,20 @@ files conditionalize this setup based on the TERM
environment variable."
:type 'string)
;;;###tramp-autoload
-(defcustom tramp-histfile-override "/dev/null"
+(defcustom tramp-histfile-override t
"When invoking a shell, override the HISTFILE with this value.
-By default, the HISTFILE is set to the \"/dev/null\" value, which
-is special on Unix systems and indicates the shell history should
-not be logged (this avoids clutter due to Tramp commands).
+When setting to a string, it redirects the shell history to that
+file. Be careful when setting to \"/dev/null\"; this might
+result in undesired results when using \"bash\" as shell.
+The value t, the default value, unsets any setting of HISTFILE.
If you set this variable to nil, however, the *override* is
disabled, so the history will go to the default storage
location, e.g. \"$HOME/.sh_history\"."
:group 'tramp
:version "25.1"
:type '(choice (const :tag "Do not override HISTFILE" nil)
- (const :tag "Empty the history (/dev/null)" "/dev/null")
+ (const :tag "Unset HISTFILE" t)
(string :tag "Redirect to a file")))
;;;###tramp-autoload
@@ -3902,9 +3903,12 @@ file exists and nonzero exit status otherwise."
;; the prompt in /bin/bash, it must be discarded as well.
(tramp-send-command
vec (format
- "exec env ENV=''%s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
+ "exec env ENV='' %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"
(if tramp-histfile-override
- (concat " HISTFILE=" tramp-histfile-override)
+ (concat
+ "HISTFILE="
+ (if (stringp tramp-histfile-override)
+ (tramp-shell-quote-argument tramp-histfile-override) ""))
"")
(tramp-shell-quote-argument tramp-end-of-output)
shell (or extra-args ""))
@@ -4628,7 +4632,9 @@ connection if a previous connection has died for some
reason."
(setenv "TERM" tramp-terminal-type)
(setenv "LC_ALL" "en_US.utf8")
(when tramp-histfile-override
- (setenv "HISTFILE" tramp-histfile-override))
+ (setenv "HISTFILE"
+ (and (stringp tramp-histfile-override)
+ tramp-histfile-override)))
(setenv "PROMPT_COMMAND")
(setenv "PS1" tramp-initial-end-of-output)
(let* ((target-alist (tramp-compute-multi-hops vec))