[nongnu] elpa/helm c9f3a04cc1 1/3: [WIP] Add new file helm-packages and its bindings

[ELPA Syncer]

branch: elpa/helm
commit c9f3a04cc1176c527c58e9f65bdd180524353fd4
Author: Thierry Volpiatto <thievol@posteo.net>
Commit: Thierry Volpiatto <thievol@posteo.net>

    [WIP] Add new file helm-packages and its bindings
    
    It is to replace removed old helm-elisp-package.
---
 helm-easymenu.el        |   2 +
 helm-global-bindings.el |   1 +
 helm-packages.el        | 164 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 167 insertions(+)

diff --git a/helm-easymenu.el b/helm-easymenu.el
index a4f134ece7..e0e6556768 100644
--- a/helm-easymenu.el
+++ b/helm-easymenu.el
@@ -47,6 +47,8 @@
     ["Emacs Manual index" helm-info-emacs t]
     ["Gnus Manual index" helm-info-gnus t]
     ["Helm documentation" helm-documentation t])
+   ("Elpa"
+    ["Elisp packages" helm-packages t])
    ("Tools"
     ["Occur" helm-occur t]
     ["Grep current directory with AG" helm-do-grep-ag t]
diff --git a/helm-global-bindings.el b/helm-global-bindings.el
index f13456ea4a..d193dfecaa 100644
--- a/helm-global-bindings.el
+++ b/helm-global-bindings.el
@@ -83,6 +83,7 @@ Using `setq' to modify this variable will have no effect."
     (define-key map (kbd "C-c C-x")   'helm-run-external-command)
     (define-key map (kbd "b")         'helm-resume)
     (define-key map (kbd "M-g i")     'helm-gid)
+    (define-key map (kbd "@")         'helm-packages)
     map)
   "Default keymap for \\[helm-command-prefix] commands.
 The normal global definition of the character \\[helm-command-prefix] 
indirects to this keymap.")
diff --git a/helm-packages.el b/helm-packages.el
new file mode 100644
index 0000000000..cb1e42572a
--- /dev/null
+++ b/helm-packages.el
@@ -0,0 +1,164 @@
+;;; 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)
+
+;;; Actions
+;;
+;;
+(defun helm-packages-upgrade (_candidate)
+  (let ((mkd (helm-marked-candidates)))
+    (mapc #'package-upgrade mkd)))
+
+(defun helm-packages-describe (candidate)
+  (describe-package candidate))
+
+(defun helm-packages-visit-homepage (candidate)
+  (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)
+  (let ((mkd (helm-marked-candidates)))
+    (mapc #'package-reinstall mkd)))
+
+(defun helm-packages-delete-1 (packages &optional force)
+  (mapc (lambda (x)
+          (package-delete (package-get-descriptor x) force))
+        packages))
+
+(defun helm-packages-uninstall (_candidate)
+  (let ((mkd (helm-marked-candidates)))
+    (helm-packages-delete-1 mkd)))
+
+(defun helm-packages-delete (_candidate)
+  (let ((mkd (helm-marked-candidates)))
+    (helm-packages-delete-1 mkd 'force)))
+
+(defun helm-packages-recompile (_candidate)
+  (let ((mkd (helm-marked-candidates)))
+    (mapc #'package-recompile mkd)))
+
+(defun helm-packages-install (_candidate)
+  (let ((mkd (helm-marked-candidates)))
+    (mapc #'package-install mkd)))
+
+;;; Transformer
+;;
+;;
+(defun helm-packages-transformer (candidates _source)
+  (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"
+                              (propertize c 'face 'font-lock-keyword-face 
'match-part c)
+                              (make-string (1+ (- 
(helm-in-buffer-get-longest-candidate)
+                                                  (length c)))
+                                           ? )
+                              (or status "")
+                              (make-string (1+ (- 10 (length status))) ? )
+                              (or provider "")
+                              (make-string (1+ (- 10 (length provider))) ? )
+                              (or version "")
+                              (make-string (1+ (- 20 (length version))) ? )
+                              (if description
+                                  (propertize description 'face 
'font-lock-warning-face)
+                                ""))
+           collect (cons disp c)))
+
+;;;###autoload
+(defun helm-packages (&optional arg)
+  (interactive "P")
+  (package-initialize)
+  (when arg
+    (package-refresh-contents))
+  (let ((upgrades (package--upgradeable-packages))
+        (removables (package--removable-packages)))
+    (helm :sources (list
+                    (helm-build-sync-source "Availables for upgrade"
+                      :candidates upgrades
+                      :filtered-candidate-transformer
+                      (lambda (candidates _source)
+                        (cl-loop for c in candidates
+                                 collect (cons (propertize
+                                                (symbol-name c)
+                                                'face 'font-lock-keyword-face)
+                                               c)))
+                      :coerce #'helm-symbolify
+                      :action '(("Upgrade package(s)" . 
helm-packages-upgrade)))
+                    (helm-build-sync-source "Packages to delete"
+                      :candidates removables
+                      :coerce #'helm-symbolify
+                      :filtered-candidate-transformer
+                      (lambda (candidates _source)
+                        (cl-loop for c in candidates
+                                 collect (cons (propertize
+                                                (symbol-name c)
+                                                'face 'font-lock-keyword-face)
+                                               c)))
+                      :action '(("Delete package(s)" . helm-packages-delete)))
+                    (helm-build-in-buffer-source "Installed packages"
+                      :data (mapcar #'car package-alist)
+                      :coerce #'helm-symbolify
+                      :filtered-candidate-transformer
+                      '(helm-packages-transformer
+                        (lambda (candidates _source)
+                          (sort candidates #'helm-generic-sort-fn)))
+                      :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)))
+                    (helm-build-in-buffer-source "Other packages"
+                      :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")))
+                                                (and id (assoc sym 
package--builtins)))
+                                     nconc (list (car p)))
+                      :coerce #'helm-symbolify
+                      :filtered-candidate-transformer
+                      '(helm-packages-transformer
+                        (lambda (candidates _source)
+                          (sort candidates #'helm-generic-sort-fn)))
+                      :action '(("Describe package" . helm-packages-describe)
+                                ("Visit homepage" . 
helm-packages-visit-homepage)
+                                ("Install packages(s)" . 
helm-packages-install))))
+          :buffer "*helm test*")))
+
+(provide 'helm-packages)
+
+;;; helm-packages ends here