Simple tools for upgrading emacs packages

packages-update-interactive

;;; packages-update-interactive.el --- Simple tools for upgrading Emacs packages interactively
;; -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:

(require 'package)
(require 'time-date)

(defcustom package-refresh-interval 2
  "DAYS until `package-refresh-contents'."
  :type 'number
  :group 'package)

(defun pui--unselected-p ()
  "Check if current line is selected."
  (equal 32 (char-after (line-beginning-position))))

(defun pui--is-vc-p ()
  "Check if current line is a vc package."
  (save-excursion
    (goto-char (- (line-end-position) 4))
    (looking-at "\(vc\)")))

(defun pui--select ()
  "Select package in current line."
  (if (and (> (line-number-at-pos) 4)
	   (pui--unselected-p))
      (let ((inhibit-read-only t))
	(save-excursion
	  (goto-char (line-beginning-position))
	  (delete-char 1)
	  (insert "S")))))

(defun pui--unselect ()
  "Unselect package in current line."
  (if (and (> (line-number-at-pos) 4)
	   (not (pui--unselected-p)))
      (let ((inhibit-read-only t))
	(save-excursion
	  (goto-char (line-beginning-position))
	  (delete-char 1)
	  (insert " ")))))

(defun package-refresh-contents? ()
  "Refresh package only if `package-refresh-interval' days has passed and with prompt."
  (interactive)
  (if (and (or (not package-archive-contents)
	       (<= package-refresh-interval
		   (time-to-number-of-days
		    (time-since
		     (file-attribute-modification-time
		      (file-attributes
		       (concat package-user-dir "/archives/gnu/archive-contents")))))))
	   (y-or-n-p "Refresh packages now?"))
      (package-refresh-contents)))

(defun package-upgrade-interactively ()
  "Upgrade all packages."
  (interactive)
  (if (called-interactively-p 'interactive)
      (package-refresh-contents)
    (package-refresh-contents?))
  (if-let ((upgradable-packages (package--upgradeable-packages)))
      (with-current-buffer (get-buffer-create "*upgrade-package-interactively*")
	(save-selected-window
	  (let ((inhibit-read-only t))
	    (erase-buffer)
	    (setq buffer-read-only t)
	    (switch-to-buffer-other-window (current-buffer))
	    (set-window-dedicated-p (selected-window) t)

	    (insert "Package to Update:
s Select      C-S-v Select All VC       C-S-s Select All      [RET] Confirm
u Unselect    M-S-v Unselect All VC     C-S-u Unselect All    q     Quit\n\n")

	    (save-excursion
	      (dolist (elem upgradable-packages)
		(insert (format "   %s " elem))
		(let ((pkg-desc (cadr (assq elem package-alist)))
		      (arch-pkg-desc (cadr (assq elem package-archive-contents))))
		  (insert (format "(%s) " (mapconcat 'number-to-string (package-desc-version pkg-desc) ".")))
		  (insert
		   (if (package-vc-p pkg-desc)
		       "(vc)"
		     (format "=> (%s)" (mapconcat 'number-to-string (package-desc-version arch-pkg-desc) ".")))
		   "\n"))))

	    (local-set-key
	     (kbd "s")
	     (lambda ()
	       (interactive)
	       (pui--select)))

	    (local-set-key
	     (kbd "u")
	     (lambda ()
	       (interactive)
	       (pui--unselect)))

	    (local-set-key
	     (kbd "C-S-s")
	     (lambda ()
	       (interactive)
	       (save-excursion
		 (goto-line 5)
		 (while (not (eobp))
		   (pui--select)
		   (forward-line)))))

	    (local-set-key
	     (kbd "C-S-u")
	     (lambda ()
	       (interactive)
	       (save-excursion
		 (goto-line 5)
		 (while (not (eobp))
		   (pui--unselect)
		   (forward-line)))))

	    (local-set-key
	     (kbd "C-S-v")
	     (lambda ()
	       (interactive)
	       (save-excursion
		 (goto-line 5)
		 (while (not (eobp))
		   (if (pui--is-vc-p)
		       (pui--select))
		   (forward-line)))))

	    (local-set-key
	     (kbd "M-S-v")
	     (lambda ()
	       (interactive)
	       (save-excursion
		 (goto-line 5)
		 (while (not (eobp))
		   (if (pui--is-vc-p)
		       (pui--unselect))
		   (forward-line)))))

	    (local-set-key
	     (kbd "RET")
	     `(lambda ()
		(interactive)
		(goto-line 5)
		(let ((empty-selection-p t))
		  (while (not (eobp))
		    (when (not (pui--unselected-p))
		      (setq empty-selection-p nil)
		      (package-upgrade (nth (- (line-number-at-pos) 5) ',upgradable-packages)))
		    (forward-line))
		  (if empty-selection-p
		      (message "Empty selection, press q to quit")
		    (kill-buffer-and-window)))))

	    (local-set-key (kbd "q") 'kill-buffer-and-window))))
    (message "All package are up-to-date")))

(provide 'packages-update-interactive)
;;; packages-update-interactive.el ends here

Preview:

This seems neat, would you be interested in preparing this into a package that could be added to GNU ELPA?

This seems neat, would you be interested in preparing this into a package that could be added to GNU ELPA?

Sure. Do you want to continue on it, or would you like me to improve on it? One I could think of is adding support for <29, which only lack package--upgradeable-packages and package-upgrade. And no vc support also.

"qxxt" ***@***.***> writes:

@qxxt commented on this gist: > This seems neat, would you be interested in preparing this into a package that could be added to GNU ELPA? Sure. Do you want to continue on it, or would you like me to improve on it? One I could think of is adding support for <29, which only lack `package--upgradeable-packages` and `package-upgrade`. And no vc support also.

I personally have no need for this, and my time is currently somewhat limited so I'd invite you to work on this (be it here or as a patch to the core).

…

-- Philip Kaludercic