289 lines
13 KiB
EmacsLisp
289 lines
13 KiB
EmacsLisp
;;; helm-packages.el --- helm interface to manage packages -*- lexical-binding: t; -*-
|
||
|
||
;; Copyright (C) 2012 ~ 2023 Thierry Volpiatto
|
||
|
||
;; 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 <http://www.gnu.org/licenses/>.
|
||
|
||
|
||
;;; Code:
|
||
|
||
(require 'cl-lib)
|
||
(require 'helm)
|
||
(require 'package)
|
||
(require 'helm-utils) ; For with-helm-display-marked-candidates.
|
||
|
||
|
||
(defclass helm-packages-class (helm-source-in-buffer)
|
||
((coerce :initform #'helm-symbolify)
|
||
(find-file-target :initform #'helm-packages-quit-an-find-file)
|
||
(filtered-candidate-transformer
|
||
:initform
|
||
'(helm-packages-transformer
|
||
(lambda (candidates _source)
|
||
(sort candidates #'helm-generic-sort-fn))))
|
||
(update :initform #'helm-packages--refresh-contents))
|
||
"A class to define `helm-packages' sources.")
|
||
|
||
;;; Actions
|
||
;;
|
||
;;
|
||
(defun helm-packages-upgrade (_candidate)
|
||
"Helm action for upgrading marked packages."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Upgrade %s packages? " (length mkd)))
|
||
(mapc #'package-upgrade mkd)))))
|
||
|
||
(defun helm-packages-describe (candidate)
|
||
"Helm action for describing package CANDIDATE."
|
||
(describe-package candidate))
|
||
|
||
(defun helm-packages-visit-homepage (candidate)
|
||
"Helm action for visiting package CANDIDATE home page."
|
||
(let* ((id (package-get-descriptor candidate))
|
||
(name (package-desc-name id))
|
||
(extras (package-desc-extras id))
|
||
(url (and (listp extras) (cdr-safe (assoc :url extras)))))
|
||
(if (stringp url)
|
||
(browse-url url)
|
||
(message "Package %s has no homepage"
|
||
(propertize (symbol-name name)
|
||
'face 'font-lock-keyword-face)))))
|
||
|
||
(defun helm-packages-package-reinstall (_candidate)
|
||
"Helm action for reinstalling marked packages."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Reinstall %s packages? " (length mkd)))
|
||
(mapc #'package-reinstall mkd)))))
|
||
|
||
(defun helm-packages-delete-1 (packages &optional force)
|
||
"Run `package-delete' on PACKAGES.
|
||
If FORCE is non nil force deleting packages."
|
||
(mapc (lambda (x)
|
||
(package-delete (package-get-descriptor x) force))
|
||
packages))
|
||
|
||
(defun helm-packages-uninstall (_candidate)
|
||
"Helm action for uninstalling marked packages.
|
||
Unlike `helm-packages-delete' this will refuse to delete packages when they are
|
||
needed by others packages as dependencies."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Uninstall %s packages? " (length mkd)))
|
||
(helm-packages-delete-1 mkd)))))
|
||
|
||
(defun helm-packages-delete (_candidate)
|
||
"Helm action for deleting marked packages.
|
||
Unlike `helm-packages-uninstall' this delete packages even when they are needed
|
||
as dependencies."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Delete %s packages? " (length mkd)))
|
||
(helm-packages-delete-1 mkd 'force)))))
|
||
|
||
(defun helm-packages-recompile (_candidate)
|
||
"Helm action for recompiling marked packages."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Recompile %s packages? " (length mkd)))
|
||
(mapc #'package-recompile mkd)))))
|
||
|
||
(defun helm-packages-install (_candidate)
|
||
"Helm action for installing marked packages."
|
||
(let ((mkd (helm-marked-candidates)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
(mapcar #'symbol-name mkd)
|
||
(when (y-or-n-p (format "Install %s packages? " (length mkd)))
|
||
(condition-case err
|
||
(mapc #'package-install mkd)
|
||
(error "%S:\n Please refresh package list before installing" err))))))
|
||
|
||
(defun helm-packages-isolate-1 (packages)
|
||
"Start an Emacs with only PACKAGES loaded.
|
||
Arg PACKAGES is a list of strings."
|
||
(let* ((name (concat "package-isolate-" (mapconcat #'identity packages "_")))
|
||
(deps (cl-loop for p in packages
|
||
for sym = (intern p)
|
||
nconc (package--dependencies sym))))
|
||
(apply #'start-process name nil
|
||
(list (expand-file-name invocation-name invocation-directory)
|
||
"-Q" "--debug-init"
|
||
(format "--eval=%S"
|
||
`(progn
|
||
(require 'package)
|
||
(setq package-load-list
|
||
',(append (mapcar (lambda (p) (list (intern p) t))
|
||
packages)
|
||
(mapcar (lambda (p) (list p t)) deps)))
|
||
(package-initialize)))))))
|
||
|
||
(defun helm-packages-isolate (_candidate)
|
||
"Start a new Emacs with only marked packages loaded."
|
||
(let* ((mkd (helm-marked-candidates))
|
||
(pkg-names (mapcar #'symbol-name mkd))
|
||
(isolate (if (fboundp 'package-isolate)
|
||
#'package-isolate
|
||
#'helm-packages-isolate-1)))
|
||
(with-helm-display-marked-candidates
|
||
helm-marked-buffer-name
|
||
pkg-names
|
||
(when (y-or-n-p "Start a new Emacs with only package(s)? ")
|
||
(funcall isolate pkg-names)))))
|
||
|
||
(defun helm-packages-quit-an-find-file (source)
|
||
"`find-file-target' function for `helm-packages'."
|
||
(let* ((sel (helm-get-selection nil nil source))
|
||
(pkg (package-get-descriptor (intern sel))))
|
||
(if (and pkg (package-installed-p pkg))
|
||
(expand-file-name (package-desc-dir pkg))
|
||
package-user-dir)))
|
||
|
||
;;; Transformers
|
||
;;
|
||
;;
|
||
(defun helm-packages-transformer (candidates _source)
|
||
"Transformer function for `helm-packages'."
|
||
(cl-loop for c in candidates
|
||
for sym = (intern-soft c)
|
||
for archive = (assq sym package-archive-contents)
|
||
for id = (package-get-descriptor sym)
|
||
for provider = (and archive (package-desc-archive (cadr archive)))
|
||
for status = (and id (package-desc-status id))
|
||
for version = (and id (mapconcat #'number-to-string (package-desc-version id) "."))
|
||
for description = (and id (package-desc-summary id))
|
||
for disp = (format "%s%s%s%s%s%s%s%s%s"
|
||
;; Package name.
|
||
(propertize
|
||
c
|
||
'face (if (equal status "dependency")
|
||
font-lock-type-face
|
||
'font-lock-keyword-face)
|
||
'match-part c)
|
||
;; Separator.
|
||
(make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
||
(length c)))
|
||
? )
|
||
;; Package status.
|
||
(propertize
|
||
(or status "")
|
||
'face (if (equal status "dependency")
|
||
'bold-italic
|
||
'default))
|
||
;; Separator.
|
||
(make-string (1+ (- 10 (length status))) ? )
|
||
;; Package provider.
|
||
(or provider "")
|
||
;; Separator.
|
||
(make-string (1+ (- 10 (length provider))) ? )
|
||
;; Package version.
|
||
(or version "")
|
||
;; Separator.
|
||
(make-string (1+ (- 20 (length version))) ? )
|
||
;; Package description.
|
||
(if description
|
||
(propertize description 'face 'font-lock-warning-face)
|
||
""))
|
||
collect (cons disp c)))
|
||
|
||
(defun helm-packages-transformer-1 (candidates _source)
|
||
"Transformer function for `helm-packages' upgrade and delete sources."
|
||
(cl-loop for c in candidates
|
||
collect (cons (propertize c 'face 'font-lock-keyword-face) c)))
|
||
|
||
(defvar helm-packages--updated nil)
|
||
(defun helm-packages--refresh-contents ()
|
||
(unless helm-packages--updated (package-refresh-contents))
|
||
(helm-set-local-variable 'helm-packages--updated t))
|
||
|
||
|
||
;;;###autoload
|
||
(defun helm-packages (&optional arg)
|
||
"Helm interface to manage packages.
|
||
|
||
With a prefix arg ARG refresh package list.
|
||
|
||
When installing or upgrading ensure to refresh the package list
|
||
to avoid errors with outdated packages no more availables."
|
||
(interactive "P")
|
||
(package-initialize)
|
||
(when arg (helm-packages--refresh-contents))
|
||
(let ((upgrades (package--upgradeable-packages))
|
||
(removables (package--removable-packages)))
|
||
(helm :sources (list
|
||
(helm-make-source "Availables for upgrade" 'helm-packages-class
|
||
:init (lambda ()
|
||
(helm-init-candidates-in-buffer 'global upgrades))
|
||
:filtered-candidate-transformer #'helm-packages-transformer-1
|
||
:action '(("Upgrade package(s)"
|
||
. helm-packages-upgrade)))
|
||
(helm-make-source "Packages to delete" 'helm-packages-class
|
||
:init (lambda ()
|
||
(helm-init-candidates-in-buffer 'global removables))
|
||
:filtered-candidate-transformer #'helm-packages-transformer-1
|
||
:action '(("Delete package(s)" . helm-packages-delete)))
|
||
(helm-make-source "Installed packages" 'helm-packages-class
|
||
:init (lambda ()
|
||
(helm-init-candidates-in-buffer 'global
|
||
(mapcar #'car package-alist)))
|
||
:action '(("Describe package" . helm-packages-describe)
|
||
("Visit homepage" . helm-packages-visit-homepage)
|
||
("Reinstall package(s)"
|
||
. helm-packages-package-reinstall)
|
||
("Recompile package(s)" . helm-packages-recompile)
|
||
("Uninstall package(s)" . helm-packages-uninstall)
|
||
("Isolate package(s)" . helm-packages-isolate)))
|
||
(helm-make-source "Available external packages" 'helm-packages-class
|
||
:data (cl-loop for p in package-archive-contents
|
||
for sym = (car p)
|
||
for id = (package-get-descriptor sym)
|
||
for status = (package-desc-status id)
|
||
unless (or (and id (member
|
||
status
|
||
'("installed" "dependency" "source")))
|
||
(and id (assoc sym package--builtins)))
|
||
nconc (list (car p)))
|
||
:action '(("Describe package" . helm-packages-describe)
|
||
("Visit homepage" . helm-packages-visit-homepage)
|
||
("Install packages(s)"
|
||
. helm-packages-install)))
|
||
(helm-make-source "Available built-in packages" 'helm-packages-class
|
||
:data (cl-loop for p in package--builtins
|
||
;; Show only builtins that are available as
|
||
;; well on (m)elpa. Other builtins don't
|
||
;; have a package-descriptor, the format is
|
||
;; (sym . [version reqs summary]).
|
||
when (package-desc-p (package-get-descriptor (car p)))
|
||
collect (car p))
|
||
:action '(("Describe package" . helm-packages-describe)
|
||
("Visit homepage" . helm-packages-visit-homepage)
|
||
("Install packages(s)"
|
||
. helm-packages-install))))
|
||
:buffer "*helm packages*")))
|
||
|
||
(provide 'helm-packages)
|
||
|
||
;;; helm-packages ends here
|