2023-08-30 13:03:41 +00:00
|
|
|
|
;;; 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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(require 'finder)
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(require 'helm-utils) ; For with-helm-display-marked-candidates.
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(require 'async-package)
|
|
|
|
|
|
|
|
|
|
|
|
(declare-function dired-async-mode-line-message "ext:dired-async.el")
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(defgroup helm-packages nil
|
|
|
|
|
|
"Helm interface for package.el."
|
|
|
|
|
|
:group 'helm)
|
|
|
|
|
|
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(sort candidates #'helm-generic-sort-fn))))
|
|
|
|
|
|
(update :initform #'helm-packages--refresh-contents))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
"A class to define `helm-packages' sources.")
|
2024-07-28 16:03:37 +00:00
|
|
|
|
|
|
|
|
|
|
(defcustom helm-packages-async t
|
|
|
|
|
|
"Install packages async when non nil."
|
|
|
|
|
|
:type 'boolean)
|
|
|
|
|
|
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
;;; Actions
|
|
|
|
|
|
;;
|
|
|
|
|
|
;;
|
|
|
|
|
|
(defun helm-packages-upgrade (_candidate)
|
|
|
|
|
|
"Helm action for upgrading marked packages."
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(let ((mkd (helm-marked-candidates))
|
|
|
|
|
|
(error-file (expand-file-name
|
|
|
|
|
|
"helm-packages-upgrade-error.txt"
|
|
|
|
|
|
temporary-file-directory)))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(with-helm-display-marked-candidates
|
|
|
|
|
|
helm-marked-buffer-name
|
|
|
|
|
|
(mapcar #'symbol-name mkd)
|
|
|
|
|
|
(when (y-or-n-p (format "Upgrade %s packages? " (length mkd)))
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(if helm-packages-async
|
|
|
|
|
|
(async-package-do-action 'upgrade mkd error-file)
|
|
|
|
|
|
(mapc #'package-upgrade mkd))))))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
(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."
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(let ((mkd (helm-marked-candidates))
|
|
|
|
|
|
(error-file (expand-file-name
|
|
|
|
|
|
"helm-packages-reinstall-error.txt"
|
|
|
|
|
|
temporary-file-directory)))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(with-helm-display-marked-candidates
|
|
|
|
|
|
helm-marked-buffer-name
|
|
|
|
|
|
(mapcar #'symbol-name mkd)
|
|
|
|
|
|
(when (y-or-n-p (format "Reinstall %s packages? " (length mkd)))
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(if helm-packages-async
|
|
|
|
|
|
(async-package-do-action 'reinstall mkd error-file)
|
|
|
|
|
|
(mapc #'package-reinstall mkd))))))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
(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)))))
|
|
|
|
|
|
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(defun helm-packages-install--sync (packages)
|
|
|
|
|
|
(condition-case err
|
|
|
|
|
|
(mapc #'package-install packages)
|
|
|
|
|
|
(error "%S:\n Please refresh package list before installing" err)))
|
|
|
|
|
|
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(defun helm-packages-install (_candidate)
|
|
|
|
|
|
"Helm action for installing marked packages."
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(let ((mkd (helm-marked-candidates))
|
|
|
|
|
|
(error-file (expand-file-name
|
|
|
|
|
|
"helm-packages-install-error.txt"
|
|
|
|
|
|
temporary-file-directory)))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(with-helm-display-marked-candidates
|
|
|
|
|
|
helm-marked-buffer-name
|
|
|
|
|
|
(mapcar #'symbol-name mkd)
|
|
|
|
|
|
(when (y-or-n-p (format "Install %s packages? " (length mkd)))
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(if helm-packages-async
|
|
|
|
|
|
(async-package-do-action 'install mkd error-file)
|
|
|
|
|
|
(helm-packages-install--sync mkd))))))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
(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
|
2024-07-28 16:03:37 +00:00
|
|
|
|
'face
|
|
|
|
|
|
(helm-acase status
|
|
|
|
|
|
("dependency" 'font-lock-type-face)
|
|
|
|
|
|
("disabled" 'default)
|
|
|
|
|
|
(t 'font-lock-keyword-face))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
'match-part c)
|
|
|
|
|
|
;; Separator.
|
|
|
|
|
|
(make-string (1+ (- (helm-in-buffer-get-longest-candidate)
|
|
|
|
|
|
(length c)))
|
|
|
|
|
|
? )
|
|
|
|
|
|
;; Package status.
|
|
|
|
|
|
(propertize
|
|
|
|
|
|
(or status "")
|
2024-07-28 16:03:37 +00:00
|
|
|
|
'face (helm-acase status
|
|
|
|
|
|
("dependency" 'bold-italic)
|
|
|
|
|
|
("disabled" 'font-lock-property-name-face)
|
|
|
|
|
|
(t 'default)))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
;; 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)))
|
2024-07-28 16:03:37 +00:00
|
|
|
|
|
|
|
|
|
|
(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))
|
|
|
|
|
|
|
|
|
|
|
|
(defun helm-finder--list-matches (key)
|
|
|
|
|
|
(let* ((id (intern key))
|
|
|
|
|
|
(packages (gethash id finder-keywords-hash)))
|
|
|
|
|
|
(unless packages
|
|
|
|
|
|
(error "No packages matching key `%s'" key))
|
|
|
|
|
|
packages))
|
|
|
|
|
|
|
2023-08-30 13:03:41 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
(when arg (helm-packages--refresh-contents))
|
|
|
|
|
|
(let ((upgrades (cl-loop for p in (package--upgradeable-packages)
|
|
|
|
|
|
unless (helm-aand (assq p package-load-list)
|
|
|
|
|
|
(or (null (cadr it)) (stringp (cadr it))))
|
|
|
|
|
|
collect p))
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(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
|
2024-07-28 16:03:37 +00:00
|
|
|
|
:action '(("Upgrade package(s)"
|
2023-08-30 13:03:41 +00:00
|
|
|
|
. 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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
("Reinstall package(s)"
|
2023-08-30 13:03:41 +00:00
|
|
|
|
. 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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
("Install packages(s)"
|
2023-08-30 13:03:41 +00:00
|
|
|
|
. 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)
|
2024-07-28 16:03:37 +00:00
|
|
|
|
("Install packages(s)"
|
2023-08-30 13:03:41 +00:00
|
|
|
|
. helm-packages-install))))
|
|
|
|
|
|
:buffer "*helm packages*")))
|
|
|
|
|
|
|
2024-07-28 16:03:37 +00:00
|
|
|
|
;;;###autoload
|
|
|
|
|
|
(defun helm-finder ()
|
|
|
|
|
|
"Helm interface to find packages by keywords with `finder'."
|
|
|
|
|
|
(interactive)
|
|
|
|
|
|
(helm :sources
|
|
|
|
|
|
(helm-build-in-buffer-source "helm finder"
|
|
|
|
|
|
:data (mapcar #'car finder-known-keywords)
|
|
|
|
|
|
:filtered-candidate-transformer
|
|
|
|
|
|
(lambda (candidates _source)
|
|
|
|
|
|
(cl-loop for cand in candidates
|
|
|
|
|
|
for desc = (assoc-default (intern-soft cand) finder-known-keywords)
|
|
|
|
|
|
for sep = (helm-make-separator cand)
|
|
|
|
|
|
for disp = (helm-aand (propertize desc 'face 'font-lock-warning-face)
|
|
|
|
|
|
(propertize " " 'display (concat sep it))
|
|
|
|
|
|
(concat cand it))
|
|
|
|
|
|
collect (cons disp cand)))
|
|
|
|
|
|
:action (lambda (c)
|
|
|
|
|
|
(if (string-match "\\.el$" c)
|
|
|
|
|
|
(finder-commentary c)
|
|
|
|
|
|
(helm :sources
|
|
|
|
|
|
(helm-make-source "packages" 'helm-packages-class
|
|
|
|
|
|
:init (lambda ()
|
|
|
|
|
|
(helm-init-candidates-in-buffer
|
|
|
|
|
|
'global (helm-finder--list-matches c)))
|
|
|
|
|
|
:filtered-candidate-transformer #'helm-packages-transformer-1
|
|
|
|
|
|
:action '(("Describe package" . helm-packages-describe)))
|
|
|
|
|
|
:buffer "*helm finder results*"))))
|
|
|
|
|
|
:buffer "*helm finder*"))
|
|
|
|
|
|
|
2023-08-30 13:03:41 +00:00
|
|
|
|
(provide 'helm-packages)
|
|
|
|
|
|
|
|
|
|
|
|
;;; helm-packages ends here
|
