Skip to content

Instantly share code, notes, and snippets.

@yuezhu
Created June 12, 2020 16:22
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save yuezhu/19676d06e871f99708ccb82805bda96d to your computer and use it in GitHub Desktop.
Save yuezhu/19676d06e871f99708ccb82805bda96d to your computer and use it in GitHub Desktop.
Emacs auto update ELPA packages
(defconst package-no-https nil
"Use plain http when contacting ELPA repositories.")
(defconst package-upgrade-check-interval 7200
"Interval to perform ELPA packages upgrade check.")
(defconst package-upgrade-check-stamp
(expand-file-name "package-upgrade-check-stamp"
user-emacs-directory)
"Filename that store the timestamp that last ELPA packages
upgrade check is performed.")
(let* ((no-https (or package-no-https
(and (memq system-type '(windows-nt ms-dos))
(not (gnutls-available-p)))))
(proto (if no-https "http" "https")))
(setcdr (assoc "gnu" package-archives)
(concat proto "://elpa.gnu.org/packages/")) ;; "://mirrors.163.com/elpa/gnu/"
(add-to-list 'package-archives
(cons "melpa"
(concat proto "://melpa.org/packages/")) t)
(add-to-list 'package-archives
(cons "org"
(concat proto "://orgmode.org/elpa/")) t))
(advice-add 'package-installed-p :around
(lambda (func &rest args)
"Return if ELPA org is installed. This hides the
bulit-in org, so that we can install org from ELPA, which is
newer."
(let ((pkg (car args)))
(if (equal pkg 'org)
(assq pkg package-alist)
(apply func args)))))
(package-initialize)
(unless package-archive-contents
(package-refresh-contents))
(defun package-directory (name)
"Return the directory location that package NAME will be
installed with the current version in ELPA
`package-archive-contents'."
(let* ((pkg-desc (cadr (assq name package-archive-contents)))
(pkg-full-name (and pkg-desc
(package-desc-full-name pkg-desc))))
(if pkg-full-name
(file-name-as-directory
(concat (file-name-as-directory package-user-dir)
pkg-full-name)))))
(defun package-update ()
"Return a list of packages that have new versions available."
(let (result)
(cl-flet ((get-version
(name where)
(let ((pkg (cadr (assq name where))))
(when pkg
(package-desc-version pkg)))))
(dolist (package (mapcar #'car package-alist))
(let ((in-archive (get-version package package-archive-contents)))
(when (and in-archive
(version-list-< (get-version package package-alist)
in-archive))
(push (cadr (assq package package-archive-contents))
result)))))
result))
(defun package-do-upgrade ()
"Upgrade all ELPA packages to their latest versions."
(remove-hook 'package--post-download-archives-hook #'package-do-upgrade)
(let* ((packages (package-update))
(msg (mapconcat #'package-desc-full-name packages ", "))
(num (length packages))
(sfx (if (<= num 1) "" "s")))
(if (not packages)
(message "All packages are up to date")
(message "%d package%s available for upgrade: %s" num sfx msg)
(save-window-excursion
(dolist (package-desc packages)
(let ((new-package-full-name
(package-desc-full-name package-desc))
(old-package-desc
(cadr (assq (package-desc-name package-desc)
package-alist))))
(message "Installing package ‘%s’..." new-package-full-name)
(package-install package-desc)
(message "Installing package ‘%s’...done" new-package-full-name)
(package-delete old-package-desc))))
(message "%d package%s upgraded: %s" num sfx msg))))
(defun package-upgrade (&optional async)
"Refresh and upgrade all installed ELPA packages.
Optional argument ASYNC specifies whether to perform the
downloads in the background."
(interactive)
(message "Package refresh started at %s" (current-time-string))
(add-hook 'package--post-download-archives-hook #'package-do-upgrade)
(package-refresh-contents async))
(add-hook 'after-init-hook
(lambda ()
"Auto upgrade ELPA packages when idle for a while."
(run-with-idle-timer
600 t
(lambda ()
(let* ((now (round (float-time)))
(last (or (load-from-file package-upgrade-check-stamp) 0))
(elapsed (- now last)))
(when (>= elapsed package-upgrade-check-interval)
(package-upgrade t)
(dump-into-file now package-upgrade-check-stamp)))))
(message "Check package upgrade every %ds"
package-upgrade-check-interval)) t)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment