update packages
This commit is contained in:
145
lisp/async/async-package.el
Normal file
145
lisp/async/async-package.el
Normal file
@@ -0,0 +1,145 @@
|
||||
;;; async-package.el --- Fetch packages asynchronously -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2014-2022 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Thierry Volpiatto <thievol@posteo.net>
|
||||
|
||||
;; Keywords: dired async byte-compile package
|
||||
;; X-URL: https://github.com/jwiegley/emacs-async
|
||||
|
||||
;; This program is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Provide the function `async-package-do-action' to
|
||||
;; (re)install/upgrade packages asynchronously.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile (require 'cl-lib))
|
||||
(require 'async-bytecomp)
|
||||
(require 'dired-async)
|
||||
(require 'package)
|
||||
|
||||
(define-minor-mode async-package--modeline-mode
|
||||
"Notify mode-line that an async process run."
|
||||
:group 'async
|
||||
:global t
|
||||
:lighter (:eval (propertize (format " [%s async job Installing package(s)]"
|
||||
(length (dired-async-processes
|
||||
'async-pkg-install)))
|
||||
'face 'async-package-message))
|
||||
(unless async-package--modeline-mode
|
||||
(let ((visible-bell t)) (ding))))
|
||||
|
||||
(defvar async-pkg-install-after-hook nil
|
||||
"Hook that run after package installation.
|
||||
The hook runs in the call-back once installation is done in child emacs.")
|
||||
|
||||
(defface async-package-message
|
||||
'((t (:foreground "yellow")))
|
||||
"Face used for mode-line message."
|
||||
:group 'async)
|
||||
|
||||
(defun async-package-do-action (action packages error-file)
|
||||
"Execute ACTION asynchronously on PACKAGES.
|
||||
Argument ACTION can be one of \\='install, \\='upgrade, \\='reinstall.
|
||||
Argument PACKAGES is a list of packages (symbols).
|
||||
Argument ERROR-FILE is the file where errors are logged, if some."
|
||||
(require 'async-bytecomp)
|
||||
(let ((fn (pcase action
|
||||
('install 'package-install)
|
||||
('upgrade 'package-upgrade)
|
||||
('reinstall 'package-reinstall)))
|
||||
(action-string (pcase action
|
||||
('install "Installing")
|
||||
('upgrade "Upgrading")
|
||||
('reinstall "Reinstalling"))))
|
||||
(message "%s %s package(s)..." action-string (length packages))
|
||||
(process-put
|
||||
(async-start
|
||||
`(lambda ()
|
||||
(require 'bytecomp)
|
||||
(setq package-archives ',package-archives
|
||||
package-pinned-packages ',package-pinned-packages
|
||||
package-archive-contents ',package-archive-contents
|
||||
package-user-dir ,package-user-dir
|
||||
package-alist ',package-alist
|
||||
load-path ',load-path)
|
||||
;; Ensure `async-bytecomp-package-mode' doesn't kick in
|
||||
;; (issue #194) as some packages may enable it
|
||||
;; inconditionally. We don't need to compile async as we are
|
||||
;; already async and in a clean environment.
|
||||
(require 'async-bytecomp)
|
||||
(setq async-bytecomp-allowed-packages nil)
|
||||
(prog1
|
||||
(condition-case err
|
||||
(mapc ',fn ',packages)
|
||||
(error
|
||||
(with-temp-file ,error-file
|
||||
(insert
|
||||
(format
|
||||
"%S:\n Please refresh package list before %s"
|
||||
err ,action-string)))))
|
||||
(let (error-data)
|
||||
(when (get-buffer byte-compile-log-buffer)
|
||||
(setq error-data (with-current-buffer byte-compile-log-buffer
|
||||
(buffer-substring-no-properties
|
||||
(point-min) (point-max))))
|
||||
(unless (string= error-data "")
|
||||
(with-temp-file ,async-byte-compile-log-file
|
||||
(erase-buffer)
|
||||
(insert error-data)))))))
|
||||
(lambda (result)
|
||||
(if (file-exists-p error-file)
|
||||
(let ((buf (find-file-noselect error-file)))
|
||||
(pop-to-buffer
|
||||
buf '(nil . ((window-height . fit-window-to-buffer))))
|
||||
(special-mode)
|
||||
(delete-file error-file)
|
||||
(async-package--modeline-mode -1))
|
||||
(when result
|
||||
(let ((pkgs (if (listp result) result (list result))))
|
||||
(when (eq action 'install)
|
||||
(customize-save-variable
|
||||
'package-selected-packages
|
||||
(delete-dups (append pkgs package-selected-packages))))
|
||||
(package-load-all-descriptors) ; refresh package-alist.
|
||||
(mapc #'package-activate pkgs) ; load packages.
|
||||
(async-package--modeline-mode -1)
|
||||
(message "%s %s packages done" action-string (length packages))
|
||||
(run-with-timer
|
||||
0.1 nil
|
||||
(lambda (lst str)
|
||||
(dired-async-mode-line-message
|
||||
"%s %d package(s) done"
|
||||
'async-package-message
|
||||
str (length lst)))
|
||||
packages action-string)
|
||||
(when (file-exists-p async-byte-compile-log-file)
|
||||
(let ((buf (get-buffer-create byte-compile-log-buffer)))
|
||||
(with-current-buffer buf
|
||||
(goto-char (point-max))
|
||||
(let ((inhibit-read-only t))
|
||||
(insert-file-contents async-byte-compile-log-file)
|
||||
(compilation-mode))
|
||||
(display-buffer buf)
|
||||
(delete-file async-byte-compile-log-file)))))))
|
||||
(run-hooks 'async-pkg-install-after-hook)))
|
||||
'async-pkg-install t)
|
||||
(async-package--modeline-mode 1)))
|
||||
|
||||
(provide 'async-package)
|
||||
|
||||
;;; async-package.el ends here
|
||||
Reference in New Issue
Block a user