(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.
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")
`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.
""
(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)
(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 ()
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
;; 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.
(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
(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"
- "\f\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")
+ "\f\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)
(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)))
(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)
"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)
(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))
(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.
(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))))
;; 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)
(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)
(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)))
;; 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))
((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))
(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)
"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))))
(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.
;; 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
(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))
(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.
(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
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))
(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)
(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.
(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))
\f
(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)
(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)
(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)
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)))
(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)
(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.")
(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)
(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:
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)
(`"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
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
(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."
(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 ()
(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"))
(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.
(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
(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)
(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)
projects / emacs.git / commitdiff