;;; 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 . ;;; 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))))) "A class to define `helm-packages' sources.") ;;; Actions ;; ;; (defun helm-packages-upgrade (_candidate) "Helm action for upgrading marked packages." (let ((mkd (helm-marked-candidates))) (when (and helm-current-prefix-arg (y-or-n-p "Refresh package contents?")) (package-refresh-contents)) (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))) (when (and helm-current-prefix-arg (y-or-n-p "Refresh package contents?")) (package-refresh-contents)) (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))) (when (and helm-current-prefix-arg (y-or-n-p "Refresh package contents?")) (package-refresh-contents)) (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))) ;;;###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 (package-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) (`C-u' refresh package contents)" . 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) (`C-u' refresh package contents)" . 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) (`C-u' refresh package contents)" . 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) (`C-u' refresh package contents)" . helm-packages-install)))) :buffer "*helm packages*"))) (provide 'helm-packages) ;;; helm-packages ends here